imagebutton.pas

进销存以及BOM管理,SQl Server数据库程序

unit imagebutton;

interface

uses
  SysUtils, Classes, Controls, Messages, Windows, Consts, Forms,
  Graphics, Stdctrls, menus, Dialogs;

type
  TactiveChange = procedure(sender:Tobject;active:boolean) of object;

type
  Timagebutton = class(TGraphicControl)
  private
    Fabout:String;
    Factive:boolean;
    Fpicture:Tpicture;
    Fonprogress:TprogressEvent;
    Fstretch:Boolean;
    Fcenter:boolean;
    FincrementalDisplay:Boolean;
    Ftransparent:boolean;
    Fdrawing:boolean;
    Fproportional:boolean;
    Fonactivechange:TactiveChange;

    function getCanvas:Tcanvas;
    procedure picturechanged(sender:Tobject);
    procedure setcenter(value:boolean);
    procedure setpicture(value:Tpicture);
    procedure setstretch(value:Boolean);
    procedure settransparent(value:boolean);
    procedure setproportional(value:boolean);

    { Private declarations }
  protected
    function canautosize(var newWidth,newHeight:integer):boolean;override;
    function destrect:Trect;
    function dopalettechange:boolean;
    function getpalette:HPALETTE;override;
    procedure paint;override;
    procedure progress(sender:Tobject;stage:TprogressStage;
      percentDone:byte;RedrawNow:boolean;const R:Trect;const Msg:String);dynamic;
    procedure CMMouseenter(var message:Tmessage);message CM_MOUSEENTER;
    procedure CMMouseleave(var message:Tmessage);message CM_MOUSELEAVE;

    { Protected declarations }
  public
    constructor create(Aowner:Tcomponent);override;
    destructor destroy;override;
    property Canvas:Tcanvas read Getcanvas;
    { Public declarations }
  published
    property about:string read Fabout write fabout;
    property anchors;
    property autosize;
    property center:boolean read fcenter write setcenter default false;
    property constraints;
    property dragcursor;
    property dragkind;
    property dragmode;
    property enabled;
    property incrementaldisplay:boolean read fincrementaldisplay write fincrementaldisplay
          default false;
    property parentshowhint;
    property picture:Tpicture read fpicture write setpicture;
    property popupmenu;
    property proportional:boolean read fproportional write setproportional default false;
    property showhint;
    property stretch:boolean read fstretch write setstretch default false;
    property visible;
    property onactivechange:Tactivechange read fonactivechange write fonactivechange;
    property onclick;
    property oncontextpopup;
    property ondblclick;
    property ondragdrop;
    property ondragover;
    property onenddock;
    property onenddrag;
    property onmousedown;
    property onmousemove;
    property onmouseup;
    property onpregress:TprogressEvent read Fonprogress write Fonprogress;
    property onstartdock;
    property onstartdrag;          
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('liuxiangvcl', [Timagebutton]);
end;

{ imagebutton }

function Timagebutton.canautosize(var newWidth,
  newHeight: integer): boolean;
begin
Result:=true;
if not (csDesigning in componentstate) or (picture.width>0) and (picture.height>0) then
begin
  if align in [alnone,alleft,alright] then
    newwidth:=picture.width;
  if align in [alnone,altop,albottom] then
    newheight:=picture.height;
end;
end;

procedure timagebutton.CMMouseenter(var message: Tmessage);
begin
  Factive:=true;
  if not (csDesigning in componentstate) then
    repaint;
  if assigned(fonactivechange) then
    fonactivechange(self,true);
end;

procedure timagebutton.CMMouseleave(var message: Tmessage);
begin
  Factive:=false;
  if not (csDesigning in componentstate) then
    repaint;
  if assigned(fonactivechange) then
    fonactivechange(self,true);
end;

constructor timagebutton.create(Aowner: Tcomponent);
begin
  inherited create(Aowner);
  controlstyle:=controlstyle+[csreplicatable];
  Factive:=False;
  fpicture:=Tpicture.create;
  fpicture.onchange:=picturechanged;
  fpicture.onprogress:=progress;
  height:=105;
  width:=105;
  ftransparent:=true;
  cursor:=crhandpoint;
end;

function timagebutton.destrect: Trect;
var
  W,H,CW,CH:integer;
  xyaspect:double;
begin
  w:=picture.width;
  H:=picture.height;
  cw:=clientwidth;
  ch:=clientHeight;
  if stretch or (proportional and ((W>CW) or (H>CH))) then
    begin
      if proportional and (W>0) and (H>0) then
        begin
          xyaspect:=w/H;
          if w>H then
            begin
              w:=cw;
              h:=trunc(cw/xyaspect);
              if h>ch then
                begin
                  h:=ch;
                  w:=trunc(ch*xyaspect);
                end;
            end
            else
            begin
              h:=ch;
              w:=trunc(ch*xyaspect);
              if w>cw then
                begin
                  w:=cw;
                  h:=trunc(cw/xyaspect);
                end;
            end;
        end
        else
        begin
          w:=cw;
          h:=ch;
        end;
    end;

    with result do
      begin
        left:=0;
        top:=0;
        right:=w;
        bottom:=h;
      end;

  if center then
    offsetrect(result,(cw-w) div 2,(ch-h) div 2);
  if factive and (not (csdesigning in componentstate)) then
    begin
      dec(result.left,2);
      dec(result.right,2);
      dec(result.top,2);
      dec(result.bottom,2);
    end;
end;

destructor timagebutton.destroy;
begin
  fpicture.free;
  inherited destroy;
end;

function timagebutton.dopalettechange: boolean;
var
  parentform:Tcustomform;
  tmp:Tgraphic;
begin
  result:=false;
  tmp:=picture.graphic;
  if visible and (not (csLoading in componentstate)) and (tmp<>nil) and
    (tmp.PaletteModified) then
      begin
        if (tmp.palette=0) then
            tmp.palettemodified:=false
            else
            begin
              parentform:=getparentform(self);
              if assigned(parentform) and parentform.active and
                parentform.handleallocated then
                  begin
                    if fdrawing then
                      parentform.perform(WM_Querynewpalette,0,0)
                      else
                      postmessage(Parentform.handle,WM_querynewpalette,0,0);
                      result:=true;
                      tmp.palettemodified:=false;
                  end;
            end;
      end;
end;

function timagebutton.getCanvas: Tcanvas;
var
  bitmap:tbitmap;
begin
  if picture.graphic=nil then
    begin
      bitmap:=tbitmap.Create;
      try
        bitmap.Width:=width;
        bitmap.Height:=height;
        picture.graphic:=bitmap;
      finally
        bitmap.Free;
      end;
    end;
    if picture.graphic is Tbitmap then
      result:=Tbitmap(picture.graphic).canvas
      else
      Raise einvalidoperation.Create(simagecanvasneedsbitmap);
end;

function timagebutton.getpalette: HPALETTE;
begin
  result:=0;
  if Fpicture.graphic<>nil then
    result:=Fpicture.Graphic.palette;
end;

procedure timagebutton.paint;
var
  save:boolean;
  factivegraphic:Tgraphic;
begin
  if CSdesigning in componentstate then
    with inherited canvas do
      begin
        pen.style:=psdot;
        brush.style:=bsclear;
        rectangle(0,0,width,height);
      end;
      save:=Fdrawing;
      fdrawing:=True;
    try
      with inherited canvas do
        begin
          stretchdraw(destrect,picture.graphic);
        end;
    finally
      fdrawing:=save;
    end;
end;

procedure timagebutton.picturechanged(sender: Tobject);
var
  G:Tgraphic;
  D:Trect;
begin
  if autosize and (picture.width>0) and (picture.height>0) then
    setbounds(left,top,picture.width,picture.height);
    G:=picture.Graphic;
  if G<>nil then
    begin
      if not ((G is Tmetafile) or (G is Ticon)) then
        g.Transparent:=ftransparent;
        D:=destrect;
        if (not g.Transparent) and (D.Left<=0) and (D.Top<=0) and
          (D.Right>=width) and (d.Bottom>=height) then
          controlstyle:=controlstyle+[csopaque]
          else
          controlstyle:=controlstyle-[csopaque];
          if dopalettechange and fdrawing then
          update;
    end
    else
    controlstyle:=controlstyle-[csopaque];
    if not fdrawing then
      invalidate;
end;

procedure timagebutton.progress(sender: Tobject; stage: TprogressStage;
  percentDone: byte; RedrawNow: boolean; const R: Trect;
  const Msg: String);
begin
if fincrementaldisplay and redrawnow then
  begin
    if dopalettechange then
      update
      else
      paint;
  end;
  if assigned(fonprogress) then
  fonprogress(sender,stage,percentdone,redrawnow,r,msg);
end;

procedure timagebutton.setcenter(value: boolean);
begin
  if fcenter<>value then
    begin
      fcenter:=value;
      picturechanged(self);
    end;
end;

procedure timagebutton.setpicture(value: Tpicture);
begin
  fpicture.assign(value);
end;

procedure timagebutton.setproportional(value: boolean);
begin
  if fproportional<>value then
    begin
      fproportional:=value;
      picturechanged(self);
    end;
end;

procedure timagebutton.setstretch(value: Boolean);
begin
  if value<>Fstretch then
    begin
      fstretch:=value;
      picturechanged(self);
    end;
end;

procedure timagebutton.settransparent(value: boolean);
begin
  if value<>ftransparent then
    begin
      ftransparent:=value;
      picturechanged(self);
    end;
end;

end.