lbmorphbmp.pas

天涯進銷存系統

             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
             kf := kf + Step;
           end;
           ScanLines[y] := Line;
         end;

       for y := 0 to Height - 1 do
         begin
           GetScanLine(y,Line);
           kf := 0;
           for x := Width div 2 + 1 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + _r * (1 - kf));
             g := Round(Line^[x].g * kf + _g * (1 - kf));
             b := Round(Line^[x].b * kf + _b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
             kf := kf + Step;
           end;
           ScanLines[y] := Line;
        end;
     end;
  end;
  FreeMem(Line, Width*3);
end;


procedure TEffectBmp.AddGradBMP(BMP: TEffectBMP; Kind: TGradKind);
var
  x,y,r,g,b: Integer;
  Line, L: PLine;
  kf: Double;
  step: Double;
begin
  if (BMP.Width <> Width) or (BMP.Height <> Height) then Exit;
  GetMem(Line,Width*3);
  case Kind of
    gdLeft:
       begin
         Step := 1 / (Width - 1);
         for y := 0 to Height-1 do
         begin
           GetScanLine(y,Line);
           L := BMP.ScanLines[y];
           kf := 0;
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
             g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
             b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
             kf := kf + Step;
         end;
         ScanLines[y] := Line;
       end;
     end;
    gdRight:
       begin
         Step := 1 / (Width - 1);
         for y := 0 to Height-1 do
         begin
           GetScanLine(y,Line);
           L := BMP.ScanLines[y];
           kf := 0;
           for x := Width - 1 downto 0 do
           begin
             r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
             g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
             b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
             kf := kf + Step;
          end;
          ScanLines[y] := Line;
        end;
      end;
    gdTop:
       begin
         Step := 1 / (Height - 1);
         kf := 0;
         for y := 0 to Height-1 do
         begin
           GetScanLine(y,Line);
           L := BMP.ScanLines[y];
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
             g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
             b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
          end;
          ScanLines[y] := Line;
          kf := kf + Step;
        end;
     end;

    gdBottom:
       begin
         Step := 1 / (Height - 1);
         kf := 0;
         for y := Height - 1 downto 0 do
         begin
           GetScanLine(y,Line);
           L := BMP.ScanLines[y];
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
             g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
             b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
          end;
          ScanLines[y] := Line;
          kf := kf + Step;
        end;
     end;
    gdHCenter:
       begin
         Step := 1 / ((Height - 1) div 2);
         kf := 0;
         for y := Height div 2 to height - 1 do
         begin
           GetScanLine(y,Line);
           L := BMP.ScanLines[y];
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
             g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
             b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
          end;
          ScanLines[y] := Line;
          kf := kf + Step;
        end;
        kf := 0;
        for y := Height div 2 - 1 downto 0 do
         begin
           GetScanLine(y,Line);
           L := BMP.ScanLines[y];
           for x := 0 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
             g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
             b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
          end;
          ScanLines[y] := Line;
          kf := kf + Step;
        end;
     end;
    gdVCenter:
       begin
         Step := 1 / ((Width - 1) div 2);
         for y := 0 to Height - 1 do
         begin
           GetScanLine(y,Line);
           L := BMP.ScanLines[y];
           kf := 0;
           for x := Width div 2 downto 0 do
           begin
             r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
             g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
             b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
             kf := kf + Step;
           end;
           ScanLines[y] := Line;
         end;

       for y := 0 to Height - 1 do
         begin
           GetScanLine(y,Line);
           L := BMP.ScanLines[y];
           kf := 0;
           for x := Width div 2 + 1 to Width - 1 do
           begin
             r := Round(Line^[x].r * kf + L^[x].r * (1 - kf));
             g := Round(Line^[x].g * kf + L^[x].g * (1 - kf));
             b := Round(Line^[x].b * kf + L^[x].b * (1 - kf));
             if r > 255 then r := 255 else if r < 0 then r := 0;
             if g > 255 then g := 255 else if g < 0 then g := 0;
             if b > 255 then b := 255 else if b < 0 then b := 0;
             Line^[x].r := r;
             Line^[x].g := g;
             Line^[x].b := b;
             kf := kf + Step;
           end;
           ScanLines[y] := Line;
        end;
     end;
  end;
  FreeMem(Line,Width*3);
end;

procedure TEffectBmp.Morph(BMP: TEffectBMP; Kf: Double);
var
  x,y,r,g,b: Integer;
  Line, L: PLine;
begin
  if (BMP.Width <> Width) or (BMP.Height <> Height) then Exit;
  if kf < 0 then kf := 0;
  if kf > 1 then kf := 1;
  GetMem(Line,Width*3);
  for y := 0 to Height-1 do
  begin
    GetScanLine(y,Line);
    L := BMP.ScanLines[y];
    for x := 0 to Width - 1 do
    begin
      r := Round(Line^[x].r * (1 - kf) + L^[x].r * kf);
      g := Round(Line^[x].g * (1 - kf) + L^[x].g * kf);
      b := Round(Line^[x].b * (1 - kf) + L^[x].b * kf);
      if r > 255 then r := 255 else if r < 0 then r := 0;
      if g > 255 then g := 255 else if g < 0 then g := 0;
      if b > 255 then b := 255 else if b < 0 then b := 0;
      Line^[x].r := r;
      Line^[x].g := g;
      Line^[x].b := b;
    end;
    ScanLines[y] := Line;
  end;
  FreeMem(Line,Width*3);
end;

procedure TEffectBmp.MorphRect(BMP: TEffectBMP; Kf: Double;
                               Rct: TRect;
                               StartX, StartY: Integer);
var
  x,y,x1,y1,r,g,b: Integer;
  Line, L: PLine;
begin
  if kf < 0 then kf := 0;
  if kf > 1 then kf := 1;
  GetMem(Line,Width*3);
  y1 := StartY;
  for y := Rct.Top to Rct.Bottom do
  begin
    GetScanLine(y,Line);
    L := BMP.ScanLines[y1];
    x1 := StartX;
    for x := Rct.Left to Rct.Right do
    begin
      r := Round(Line^[x].r * (1 - kf) + L^[x1].r * kf);
      g := Round(Line^[x].g * (1 - kf) + L^[x1].g * kf);
      b := Round(Line^[x].b * (1 - kf) + L^[x1].b * kf);
      if r > 255 then r := 255 else if r < 0 then r := 0;
      if g > 255 then g := 255 else if g < 0 then g := 0;
      if b > 255 then b := 255 else if b < 0 then b := 0;
      Line^[x].r := r;
      Line^[x].g := g;
      Line^[x].b := b;
      Inc(x1);
    end;
    ScanLines[y] := Line;
    Inc(y1);
  end;
  FreeMem(Line,Width*3);
end;


procedure TEffectBmp.CopyRect(BMP: TEffectBMP; Rct: TRect;
                              StartX, StartY:Integer);
var
  x,y,x1,y1: Integer;
  Line, L: PLine;
begin
  GetMem(Line,Width*3);
  y1 := StartY;
  if Rct.Right > Width - 1 then Rct.Right := Width - 1;
  if Rct.Bottom > Height - 1 then Rct.Bottom := Height - 1;
  for y := Rct.Top to Rct.Bottom do
  begin
    GetScanLine(y,Line);
    L := BMP.ScanLines[y1];
    x1 := StartX;
    for x := Rct.Left to Rct.Right do
    begin
      Line^[x] := L^[x1];
      Inc(x1);
    end;
    ScanLines[y] := Line;
    Inc(y1);
  end;
  FreeMem(Line,Width*3);
end;



destructor TEffectBmp.Destroy;
begin
  DeleteObject(Handle);
  inherited;
end;

{$IFDEF Shareware}
function DelphiIsRunning: Boolean;
{ CDK: You may want to encrypt the following strings (and
 decrypt at run-time) to discourage reverse-engineering.
 If you do this, make sure you back up your COMPLIB.DCL
 before testing. It is also advisable to test this feature
 at run-time before installing the component onto Delphi's
 component palette. }
const
  A1: array[0..12] of char = 'TApplication'#0;
  A2: array[0..15] of char = 'TAlignPalette'#0;
  A3: array[0..18] of char = 'TPropertyInspector'#0;
  A4: array[0..11] of char = 'TAppBuilder'#0;
  T1: array[0..10] of char = 'Delphi 2.0'#0;
  T2: array[0..10] of char = 'Delphi 3'#0;
  T3: array[0..10] of char = 'Delphi 4'#0;
  T4: array[0..10] of char = 'Delphi 5'#0;
  T5: array[0..10] of char = 'C++Builder'#0;
  T6: array[0..12] of char = 'C++Builder 3'#0;
  T7: array[0..12] of char = 'C++Builder 4'#0;
  T8: array[0..12] of char = 'C++Builder 5'#0;
begin
  Result :=
    (
    (FindWindow(A1, T1) <> 0) or {Delphi 2}
    (FindWindow(A1, T2) <> 0) or {Delphi 3}
    (FindWindow(A1, T3) <> 0) or {Delphi 4}
    (FindWindow(A1, T4) <> 0) or {Delphi 5}
    (FindWindow(A1, T5) <> 0) or {C++ Builder}
    (FindWindow(A1, T6) <> 0) or {C++ Builder 3}
    (FindWindow(A1, T7) <> 0) or {C++ Builder 4}
    (FindWindow(A1, T8) <> 0)    {C++ Builder 5}
    )
    and
    (FindWindow(A2, nil) <> 0) and
    (FindWindow(A3, nil) <> 0) and
    (FindWindow(A4, nil) <> 0);
 { if not Result then
    Application.MessageBox(
   'This application makes use of unregistered shareware components. '+
   'You may want to inform the developer so that properly registered components may be included.'+
   'More information on http://www.ksdev.com and e-mail: [e-mail]',
   '抱歉', mb_OK + mb_IconStop);}
end;

{initialization
  If not DelphiIsRunning Then Halt;}
{$ENDIF}
end.