fastimage.pas

一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件

  AData : THandle;
  APalette:HPALETTE;
begin
  FBMPCopy:=TFastBmp.Create(XFinal-XOrigin+1,YFinal-YOrigin+1);
  GetMem(Line1,FBMP.width*3);
  GetMem(Line2,FBMPCopy.width*3);
  for j:=0 to FBMPCopy.height-1 do
    begin
    FBMP.GetScanLine(j+Yorigin,Line1);
    for i:=0 to FBMPCopy.width-1 do
         begin
         Line2^[i].r:=Line1^[i+Xorigin].r;
         Line2^[i].g:=Line1^[i+Xorigin].g;
         Line2^[i].b:=Line1^[i+Xorigin].b;
         end;
    FBMPCopy.ScanLines[j]:=Line2;
    end;
  FreeMem(Line1,FBMP.width*3);
  FreeMem(Line2,FBMPCopy.width*3);
  bitmap:=TBitmap.Create;
  bitmap.Width:=FBMPCopy.Width;
  bitmap.height:=FBMPCopy.Height;
  FBMPCopy.Draw(bitmap.Canvas.Handle,0,0);
  FBMPCopy.Free;
  bitmap.SaveToClipBoardFormat(MyFormat,AData,APalette);
  ClipBoard.SetAsHandle(MyFormat,AData);
  bitmap.Free;
end;

procedure TFastImage.SetWidth(value:integer);
begin
  FBMP.Width:=value;
  FPaintBox.Width:=value;
  CheckSize(self);
end;

procedure TFastImage.SetFillColor(color:TFColor);
begin
  FFillColor:=color;
  RFill:=color.r;
  GFill:=color.g;
  BFill:=color.b;
end;

procedure TFastImage.SetLineColor(color:TFColor);
begin
  FLineColor:=color;
  RLine:=color.r;
  GLine:=color.g;
  BLine:=color.b;
end;


procedure TFastImage.Setheight(value:integer);
begin
  FBMP.height:=value;
  FPaintBox.height:=value;
  CheckSize(self);
end;

function TFastImage.GetWidth:integer;
begin
  result:=FBMP.width;
end;

function TFastImage.Getheight:integer;
begin
  result:=FBMP.height;
end;

function TFastImage.GetFillColor:TFColor;
begin
  result:=FFillColor;
end;

function TFastImage.GetLineColor:TFColor;
begin
  result:=FLineColor;
end;

procedure TFastImage.Update;
begin
  paint(self);
end;


procedure TFastImage.Resample(w,h:integer;Filter:TFilterProc;FWidth:Single);
var
Bit: TFastBmp;
begin
  Bit:=TFastBmp.Create(w,h);
  FBMP.Resample(Bit,filter,FWidth);
  FBMP.Free;
  FBMP:=TFastBmp.CreateCopy(Bit);
  Bit.Free;
  FPaintBox.Width:=w;  
  FPaintBox.height:=h;
  CheckSize(self);
  Update;
end;

procedure TFastImage.AddNoiseFilter(value:byte);
begin
FBMP.AddColorNoise(value);
Update;
end;

procedure TFastImage.SandyFilter(value:byte);
begin
FBMP.AddMonoNoise(value);
Update;
end;


procedure TFastImage.SprayFilter(value:byte);
begin
FBMP.Spray(FBMP,value);
Update;
end;

procedure TFastImage.BlurFilter(value:byte);
begin
FBMP.SplitBlur(value);
Update;
end;

procedure TFastImage.WaveFilter(XDIV,YDIV,RatioVal:byte);
begin
FBMP.Wave(FBMP,XDIV,YDIV,RatioVal);
Update;
end;

procedure TFastImage.WaveWrapFilter(XDIV,YDIV,RatioVal:byte);
begin
FBMP.WaveWrap(FBMP,XDIV,YDIV,RatioVal);
Update;
end;

procedure TFastImage.SmoothPoint(xk,yk:integer);
var Bleu, Vert, Rouge: Integer;
   color:TFColor;
   BB,GG,RR: array[1..5] of Integer;
begin
if (xk>0) and (yk>0) and (xk<FBMP.width-1) and (yk<FBMP.height-1) then
     begin
     color:=FBMP.pixels[xk,yk-1];
     RR[1]:=color.r;
     GG[1]:=color.g;
     BB[1]:=color.b;
     color:=FBMP.pixels[xk+1,yk];
     RR[2]:=color.r;
     GG[2]:=color.g;
     BB[2]:=color.b;
     color:=FBMP.pixels[xk,yk+1];
     RR[3]:=color.r;
     GG[3]:=color.g;
     BB[3]:=color.b;
     color:=FBMP.pixels[xk-1,yk];
     RR[4]:=color.r;
     GG[4]:=color.g;
     BB[4]:=color.b;
     Bleu :=(BB[1]+(BB[2]+BB[3]+BB[4]))div 4;           (* Valeur moyenne *)
     Vert:=(GG[1]+(GG[2]+GG[3]+GG[4]))div 4;           (* en cours d'倂aluation        *)
     Rouge  :=(RR[1]+(RR[2]+RR[3]+RR[4]))div 4;
     color.r:=rouge;
     color.g:=vert;
     color.b:=bleu;
     FBMP.pixels[xk,yk]:=color;
     end;
end;


procedure TFastImage.AntiAliasRect(XOrigin,YOrigin,XFinal,YFinal : Integer);
var Memo,xk,yk: Integer; (* Composantes primaires des points environnants *)
begin
   if XFinal<XOrigin then begin Memo:=XOrigin; XOrigin:=XFinal; XFinal:=Memo; end;  (* Inversion des valeurs   *)
   if YFinal<YOrigin then begin Memo:=YOrigin; YOrigin:=YFinal; YFinal:=Memo; end;  (* si diff俽ence n俫ative*)
   XOrigin:=XOrigin-1;YOrigin:=YOrigin-1 ;  (* Lisser aussi les limites sup俽ieure et gauche du domaine    *)
   if XOrigin<1 then XOrigin:=1;       if YOrigin<1 then YOrigin:=1;         (* Limites du domaine  *)
   XFinal:=XFinal-1;  YFinal:=YFinal-1;
   for yk:=YOrigin to YFinal do                              (* Fonction Bloc    *)
    for xk:=XOrigin to XFinal do SmoothPoint(xk,yk);
end;


procedure TFastImage.AntiAlias;
begin
AntiAliasRect(0,0,FBMP.width-1,FBMP.height-1);
end;

procedure TFastImage.Sharpen;
begin
FBMP.Sharpen;
Update;
end;

procedure TFastImage.DiscardColor;
begin
FBMP.DiscardColor;
Update;
end;

procedure TFastImage.SplitBlur(Amount:Integer);
begin
FBMP.SplitBlur(Amount);
Update;
end;

procedure TFastImage.GaussianBlur(Amount:Integer);
begin
FBMP.GaussianBlur(Amount);
Update;
end;

procedure TFastImage.Flip;
begin
FBMP.Flop;
Update;
end;


procedure TFastImage.Mirror;
begin
FBMP.Flip;
Update;
end;

procedure TFastImage.Rotate(degree:extended;Smooth:Boolean);
var Bit:   TFastBmp;
begin
Bit:=TFastBmp.CreateCopy(FBMP);
Bit.RotateWrap(FBMP,degree,FBMP.Width div 2,FBMP.height div 2);
if smooth then AntiAlias;
Update;
end;

procedure TFastImage.SetFileName(name:string);
begin
  FFilename:=name;
  if extractfileext(FFilename)='.pcd' then
    OpenPCD(FFilename,3)
  else
    FBMP.CreateFromFile(FFilename);
  FPaintBox.width:=FBMP.width;
  FPaintBox.height:=FBMP.height;
  CheckSize(self);
  Update;
end;

procedure TFastimage.Paint(sender:TObject);
begin
if FBMP<>nil then
   begin
   if not (FStretch and Ftiling) then FBMP.Draw(FPaintBox.Canvas.Handle,0,0) else
      if not FTiling then FBMP.Stretch(FPaintBox.Canvas.Handle,0,0,width-4,height-4) else FBMP.TileDraw(FPaintBox.Canvas.Handle,0,0,width-4,height-4);
   end;
   
end;

procedure TFastimage.CheckSize(sender:TObject);
begin
  if FAutoSize and (align=alNone) then
  begin
    if width<>FBMP.width+4 then
      width:=FBMP.width+4;
    if height<>FBMP.height+4 then
      height:=FBMP.height+4;
  end;
end;

Procedure TFastimage.HorGradientLine(XOrigin,XFinal,y:integer;r1,g1,b1,r2,g2,b2:byte;smooth:boolean);
var r,g,b,i:integer;
    valueR,ValueG,ValueB,advalR,advalB,advalG:single;
    Line: PLine;
Begin
if (y>=0) and (y<FBMP.height) then
 begin
 if XOrigin>XFinal then
   begin
   i:=XOrigin;
   XOrigin:=XFinal;
   XFinal:=i;
   end;
 if XFinal<>XOrigin then
   begin
   advalR:=(r2-r1)/(XFinal-XOrigin);
   advalG:=(g2-g1)/(XFinal-XOrigin);
   advalB:=(b2-b1)/(XFinal-XOrigin);
   end
 else
   begin
   advalR:=0;
   advalG:=0;
   advalB:=0;
   end;

 valueR:=r1;
 valueG:=g1;
 valueB:=b1;
 GetMem(Line,FBMP.width*3);
 FBMP.GetScanLine(y,Line);
 for i:= XOrigin to XFinal do
    begin
    valueR:=valueR+advalR;
    r:=round(ValueR); if r>255 then r:=255; if r<0 then r:=0;
    valueG:=valueG+advalG;
    g:=round(ValueG); if g>255 then g:=255; if g<0 then g:=0;
    valueB:=valueB+advalB;
    b:=round(ValueB); if b>255 then b:=255; if b<0 then b:=0;
    if (i>=0) and (i<FBMP.width) then
       begin
       Line^[i].r:=r;
       Line^[i].g:=g;
       Line^[i].b:=b;
       end;
    end;
 FBMP.ScanLines[y]:=Line;
 FreeMem(Line,FBMP.width*3);
 if smooth then
    begin
    SmoothPoint(XOrigin-1,y);
    SmoothPoint(XFinal+1,y);
    end;
 end;
End;

Procedure TFastimage.Column(XOrigin,XFinal,YOrigin,YFinal:integer;r1,g1,b1,r2,g2,b2:byte;smooth:boolean);
var j:integer;
begin
for j:=YOrigin to YFinal do HorGradientLine(XOrigin,XFinal,j,r1,g1,b1,r2,g2,b2,smooth);
end;

procedure TFastimage.Sphere(xcenter,a,ycenter,b:integer;r1,g1,b1,r2,g2,b2:byte;smooth:boolean);
  var                                        (* Dessine un disque color