function setengah addition, blending lingkaran pada pengolahan citra digital

function Kuis1(MInput:Matriks; MInput2:Matriks; Value:integer):Matriks;
var
  i,j,k,l,r,a,b : integer;
 MOutput : matriks;
begin
 SetLength(MOutput,Length(MInput),Length(MInput[0]));
    SetLength(MInput2,Length(MInput),Length(MInput[0]));
    r:=((Length(Moutput) div 2) div 2);
    a:=((Length(Moutput) div 2) div 2)+(Length(Moutput) div 2);
    b:=(Length(Moutput[0]) div 2);
    for i:= 0 to (Length(MOutput) div 2)-1 do
      begin
        for j:= 0 to (Length(MOutput[0]))-1 do
        begin
      MOutput[i,j]:=MInput[i,j] + MInput2[i,j];
      if (MOutput[i,j]>255) then MOutput[i,j]:=255
      else if (MOutput[i,j]<0) then MOutput[i,j]:=0;
    end;
  end;
  for k:= (Length(MOutput) div 2) to Length(MOutput)-1 do
      begin
        for l:= 0 to Length(MOutput[0])-1 do
        begin
          if r>=sqrt(sqr(a-k)+sqr(b-l)) then
          begin
             MOutput[k,l]:= (round(((100-Value)/100)*MInput[k,l])) + (round((Value/100)*MInput2[k,l]));
            if (MOutput[k,l]>255) then
            MOutput[k,l]:=255
            else
            if (MOutput[k,l]<0) then MOutput[k,l]:=0;
            end
            else
            MOutput[k,l]:=MInput[k,l];
        end;
        end;
        Kuis1:=MOutput;
  end;

› Read More

Function Flip dalam lingkaran pada pengolahan citra digital

function Flip2(MInput:Matriks; pil:string):Matriks;
var
  i,j,r: integer;
 MOutput : matriks;
begin
 SetLength (MOutput,Length(MInput),Length(MInput[0]));
    r:=Length(Moutput) div 2;
if (pil='vertical') then
  begin
    for i:= 0 to Length(MOutput)-1 do
      begin
        for j:= 0 to Length(MOutput[0])-1 do
          begin
            if ((i-r)*(i-r)+(j-r)*(j-r))<=r*r then
                begin
                MOutput[i,j]:= MInput[(Length(MOutput)-1)-i,j];
                end
            else
              MOutput[i,j]:= MInput[i,j];
          end;
      end;
      end
      else
      if (pil='horisontal') then
    begin
    for i:= 0 to Length(MOutput)-1 do
      begin
        for j:= 0 to Length(MOutput[0])-1 do
          begin
            if ((i-r)*(i-r)+(j-r)*(j-r))<=r*r then
                begin
                MOutput[i,j]:=MInput[i, (Length(MOutput[0])-1)-j];
                end
            else
              MOutput[i,j]:= MInput[i,j];
          end;
      end;
      end;
 Flip2:=MOutput;
end;

› Read More

function slicing dalam lingkaran pada pengolahan citra digital

function Slicing2(MInput:Matriks; Value:integer):Matriks;
var
  i,j,r,k,tempdiv, LevelBit : integer;
 MOutput : matriks;
begin
 SetLength (MOutput,Length(MInput),Length(MInput[0]));
    r:=Length(Moutput) div 2;
    for i:= 0 to Length(MOutput)-1 do
      begin
        for j:= 0 to Length(MOutput[0])-1 do
          begin
            if ((i-r)*(i-r)+(j-r)*(j-r))<=r*r then
                begin
                LevelBit:=0;
                tempdiv:=MInput[i,j];
              for k:= 0 to Value do
              begin
                  LevelBit:=tempdiv mod 2;
                  tempdiv:=tempdiv div 2;
              end;
            if LevelBit=1 then
              LevelBit:=255;
            MOutput[i,j]:=LevelBit;
                end
            else
              MOutput[i,j]:= MInput[i,j];
          end;
      end;
 Slicing2:=MOutput;
end;

› Read More

Function Rotation pada pengolahan citra digital

Function Rotation(MInput:Matriks;pil:String):Matriks;
var
   i,j: integer;
   MOutput: Matriks;
begin
  if (pil='90C') or (pil='90UC') then
    begin
      SetLength(MOutput, Length(MInput[0]), Length(MInput));
      for i:= 0 to Length(MOutput)-1 do
        begin
          for j:=0 to Length(MOutput[0])-1 do
            begin
              if pil='90C' then
                  MOutput[i,j]:=MInput[j,(Length(MOutput)-1)-i]
              else
                  MOutput[i,j]:=MInput[(Length(MOutput[0])-1)-j,i];
            end;
        end;
    end
  else
      if (pil='180C') or (pil='180UC') then
        begin
             MOutput:=Rotation(MInput,'90C');
             MOutput:=Rotation(MOutput, '90C');
        end
          else
              if (pil='270C') then
                begin
                  MOutput:=Rotation(MInput,'90UC');
                end
              else
                begin
                  MOutput:=Rotation(MInput,'90C');
                end;
  Rotation:=MOutput;
end;

› Read More

Function Flip pada pengolahan citra digital

Function Flip(MInput:Matriks; pil:string):matriks ;
var
i,j:integer;
MOutput:Matriks;
begin
SetLength(MOutput,Length(MInput),Length(MInput[0]));
if (pil='vertical') then
  begin
  for i:=0 to Length(MOutput)-1 do
      begin
        for j:=0 to Length(MOutput[0])-1 do
          begin
          MOutput[i,j]:= MInput[(Length(MOutput)-1)-i,j];
          end;
      end;
      Flip:=MOutput;
    end
    else
    if (pil='horisontal') then
    begin
  for i:=0 to Length(MOutput)-1 do
      begin
        for j:=0 to Length(MOutput[0])-1 do
          begin
          MOutput[i,j]:=MInput[i, (Length(MOutput[0])-1)-j];
          end;
      end;
      Flip:=MOutput;
    end;
end;

› Read More

Function Slicing pada pengolahan citra digital

Function Slicing(MInput:Matriks; Value:integer):Matriks;
var
  i,j,k, tempdiv, LevelBit : integer;
  MOutput :Matriks;
begin
    SetLength (MOutput,Length(MInput),Length(MInput[0]));
    LevelBit:=0;
    for i:=0 to Length(MOutput)-1 do
      begin
        for j:=0 to Length(MOutput[0])-1 do
          begin
            tempdiv:=MInput[i,j];
            for k:= 0 to Value do
              begin
                  LevelBit:=tempdiv mod 2;
                  tempdiv:=tempdiv div 2;
              end;
            if LevelBit=1 then
              LevelBit:=255;
            MOutput[i,j]:=LevelBit;
          end;
      end;
    Slicing:=MOutput;
end;

› Read More

Function Addition versi 2 pada pengolahan citra digital

Function Addtion2(MInput,MInput2:Matriks ; X,Y:integer):Matriks;
var
i,j,k,l : integer;
MOutput : Matriks;
begin
SetLength(MOutput,Length(MInput),Length(MInput[0]));
  for i:=0 to Length(MOutput)-1 do
  begin
    for j:=0 to Length(MOutput[0])-1 do
    begin
      MOutput[i,j]:= MInput[i,j];
    end;
    end;
    if ((Length(MOutput)-X)>=Length(MInput2)) and ((Length(MOutput[0])-Y)>=Length(MInput2[0])) then
    begin
  for k:=0 to Length(MInput2)-1 do
  begin
    for l:=0 to Length(MInput2[0])-1 do
    begin
      MOutput[X+k,Y+l]:=MInput[X+k,Y+l] + MInput2[k,l];
      if (MOutput[X+k,Y+l]>255) then MOutput[X+k,Y+l]:=255
      else if (MOutput[X+k,Y+l]<0) then MOutput[X+k,Y+l]:=0;
    end;
  end;
  end
  else if ((Length(MOutput)-X)<Length(MInput2)) and ((Length(MOutput[0])-Y)>=Length(MInput2[0])) then
    begin
  for k:=0 to (Length(MOutput)-X)-1 do
  begin
    for l:=0 to Length(MInput2[0])-1 do
    begin
      MOutput[X+k,Y+l]:=MInput[X+k,Y+l] + MInput2[k,l];
      if (MOutput[X+k,Y+l]>255) then MOutput[X+k,Y+l]:=255
      else if (MOutput[X+k,Y+l]<0) then MOutput[X+k,Y+l]:=0;
    end;
  end;
  end
  else if ((Length(MOutput)-X)>=Length(MInput2)) and ((Length(MOutput[0])-Y)<Length(MInput2[0])) then
    begin
  for k:=0 to Length(MInput2)-1 do
  begin
    for l:=0 to ((Length(MOutput[0]))-Y)-1 do
    begin
      MOutput[X+k,Y+l]:=MInput[X+k,Y+l] + MInput2[k,l];
      if (MOutput[X+k,Y+l]>255) then MOutput[X+k,Y+l]:=255
      else if (MOutput[X+k,Y+l]<0) then MOutput[X+k,Y+l]:=0;
    end;
  end;
  end
  else if ((Length(MOutput)-X)<Length(MInput2)) and ((Length(MOutput[0])-Y)<Length(MInput2[0])) then
    begin
  for k:=0 to ((Length(MOutput))-X)-1 do
  begin
    for l:=0 to ((Length(MOutput[0]))-Y)-1 do
    begin
      MOutput[X+k,Y+l]:=MInput[X+k,Y+l] + MInput2[k,l];
      if (MOutput[X+k,Y+l]>255) then MOutput[X+k,Y+l]:=255
      else if (MOutput[X+k,Y+l]<0) then MOutput[X+k,Y+l]:=0;
    end;
  end;
  end;
  Addtion2:=MOutput;
end;

› Read More

Function Blending pada pengolahan citra digital

Function Blending(MInput,MInput2:Matriks; Value:integer):Matriks;
var
i,j,k,l : integer;
MOutput : Matriks;
begin
if (Length(MInput)>Length(MInput2)) then
begin
SetLength(MOutput,Length(MInput),Length(MInput[0]));
  for i:=0 to Length(MOutput)-1 do
  begin
    for j:=0 to Length(MOutput[0])-1 do
    begin
      MOutput[i,j]:= MInput[i,j];
    end;
    end;
      for k:=0 to Length(MInput2)-1 do
  begin
    for l:=0 to Length(MInput2)-1 do
    begin
      MOutput[k,l]:= (round(((100-Value)/100)*MInput[k,l])) + (round((Value/100)*MInput2[k,l]));
      if (MOutput[k,l]>255) then MOutput[k,l]:=255
      else if (MOutput[k,l]<0) then MOutput[k,l]:=0;
    end;
  end;
  end
  else if (Length(MInput)<Length(MInput2)) then
begin
SetLength(MOutput,Length(MInput2),Length(MInput2[0]));
   for i:=0 to Length(MOutput)-1 do
  begin
    for j:=0 to Length(MOutput[0])-1 do
    begin
    MOutput[i,j]:= MInput2[i,j];
    end;
    end;
      for k:=0 to Length(MInput)-1 do
  begin
    for l:=0 to Length(MInput)-1 do
    begin
      MOutput[k,l]:= (round(((100-Value)/100)*MInput2[k,l])) + (round((Value/100)*MInput[k,l]));
      if (MOutput[k,l]>255) then MOutput[k,l]:=255
      else if (MOutput[k,l]<0) then MOutput[k,l]:=0;
    end;
  end;
  end;
  Blending:=MOutput;
end;

› Read More

Function Addtion pada pengolahan citra digital

Function Addtion(MInput,MInput2:Matriks):Matriks;
var
i,j,k,l : integer;
MOutput : Matriks;
begin
if (Length(MInput)>Length(MInput2)) then
begin
SetLength(MOutput,Length(MInput),Length(MInput[0]));
  for i:=0 to Length(MOutput)-1 do
  begin
    for j:=0 to Length(MOutput[0])-1 do
    begin
      MOutput[i,j]:= MInput[i,j];
    end;
    end;
      for k:=0 to Length(MInput2)-1 do
  begin
    for l:=0 to Length(MInput2)-1 do
    begin
      MOutput[k,l]:=MInput[k,l] + MInput2[k,l];
      if (MOutput[k,l]>255) then MOutput[k,l]:=255
      else if (MOutput[k,l]<0) then MOutput[k,l]:=0;
    end;
  end;
  end
  else if (Length(MInput)<Length(MInput2)) then
begin
SetLength(MOutput,Length(MInput2),Length(MInput2[0]));
   for i:=0 to Length(MOutput)-1 do
  begin
    for j:=0 to Length(MOutput[0])-1 do
    begin
    MOutput[i,j]:= MInput2[i,j];
    end;
    end;
      for k:=0 to Length(MInput)-1 do
  begin
    for l:=0 to Length(MInput)-1 do
    begin
      MOutput[k,l]:=MInput2[k,l] + MInput[k,l];
      if (MOutput[k,l]>255) then MOutput[k,l]:=255
      else if (MOutput[k,l]<0) then MOutput[k,l]:=0;
    end;
  end;
  end;
  Addtion:=MOutput;
end;

› Read More

Function Brightness pada pengolahan citra digital

Function Brightness(MInput:Matriks; Value:integer):Matriks;
var
i,j : integer;
MOutput : Matriks;
begin
  SetLength(MOutput,Length(MInput),Length(MInput[0]));
  for i:=0 to Length(MOutput)-1 do
  begin
    for j:=0 to Length(MOutput[0])-1 do
    begin
      MOutput[i,j]:=MInput[i,j]+value;
      if (MOutput[i,j]>255) then MOutput[i,j]:=255;
      if (MOutput[i,j]<0) then MOutput[i,j]:=0;
    end;
  end;
  Brightness:=MOutput;
end;

› Read More

Function Image Negative Pada pengolahan citra digital

function ImageNegative(MInput:Matriks):Matriks;
var
  i,j : integer;
  MOutput : Matriks;
begin
  SetLength(MOutput,Length(MInput),Length(MInput[0]));
  for i:=0 to Length(MOutput)-1 do
  begin
    for j:=0 to Length(MOutput[0])-1 do
    begin
      MOutput[i,j]:=255-MInput[i,j];
    end;
  end;
  ImageNegative:=MOutput;
end;

› Read More

Function Change Pixel Value pada pengolahan citra digital

function ChangePixelValue(MInput:Matriks; X,Y,Value:integer):Matriks;
var
    i,j:integer;
    MOutput : Matriks;
begin
  SetLength(MOutput,Length(MInput),Length(MInput[0]));
  for i:=0 to Length(MOutput)-1 do
  begin
    for j:=0 to Length(MOutput[0])-1 do
    begin
    MOutput[i,j]:=MInput[i,j];
    end;
  end;
  MOutput[X,Y]:=Value;
  ChangePixelValue:=MOutput;
end;

› Read More

Menghitung luas segiempat dalam pascal versi 1

Program segiempat;

uses wincrt;

type titik=record
     x:integer;
     y:integer;
     end;

var
a:array [1..2] of titik;
i,luas,panjang,lebar:integer;

begin
writeln('(1)********');
writeln('   ********');
writeln('   ********(2)');
writeln;
for i:= 1 to 2 do
    begin
    writeln('titik ',i);
    write('masukan absis = ');readln(a[i].x);
    write('masukan ordinat = ');readln(a[i].y);
    end;
if (a[2].x>a[1].x) and (a[1].y>a[2].y) then
begin
     panjang:=a[2].x-a[1].x;
     lebar:=a[1].y-a[2].y;
     luas:=panjang*lebar;
     writeln('panjang = ',panjang);
     writeln('lebar   = ',lebar);
     writeln('luas    = ',luas);
end
else
writeln('nilai panjang/lebar bernilai minus');
end.

› Read More

Menghitung luas segitiga dalam pascal versi 1

Program segitiga;

uses wincrt;

type point=record
     absis:integer;
     ordinat:integer;
     end;

var
titik:array [1..3] of point;
i,alas,tinggi:integer;
jawaban:real;
begin
writeln('     *(3)   ');
writeln('    ***     ');
writeln('(1)******(2)');
writeln('masukan nilai titik 1, 2, 3 : ');
writeln;
for i := 1 to 3 do
    begin
        writeln('titik ',i);
        write('nilai absis = ');readln(titik[i].absis);
        write('nilai ordinat = ');readln(titik[i].ordinat);
    end;
if (titik[1].ordinat=0) and( titik[2].ordinat=0)  then
   begin
   alas:=titik[2].absis-titik[1].absis;
   tinggi:=titik[3].ordinat;
   jawaban:=((0.5*alas)*tinggi);
   writeln('alas   = ',alas);
   writeln('tinggi = ',tinggi);
   writeln('luas   = ',jawaban:0:2);
   end
else
    writeln('titik 1 dan 2 tidak menempel di garis X');
end.

› Read More

Image Processing Modul part 1 dalam delphi 7

Slahkan didownload di link berikut download

› Read More