Childwin.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:1k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit Childwin;
  2. interface
  3. uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, Main, Buttons, fcCommon, fcShapeBtn,
  4.   ComCtrls, fcDemoRichEdit;
  5. type
  6.   TMDIChild = class(TForm)
  7.     fcDemoRichEdit1: TfcDemoRichEdit;
  8.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  9.     procedure FormCreate(Sender: TObject);
  10.     procedure FormDestroy(Sender: TObject);
  11.     procedure FormActivate(Sender: TObject);
  12.   private
  13.     { Private declarations }
  14.   public
  15.     { Public declarations }
  16.   end;
  17. implementation
  18. {$R *.DFM}
  19. procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
  20. begin
  21.   Action := caFree;
  22. end;
  23. procedure TMDIChild.FormCreate(Sender: TObject);
  24. var ABitmap: TBitmap;
  25. begin
  26.   with MainMdiForm.fcButtonGroup1.ButtonItems.Add do
  27.   begin
  28.     (Button as TfcShapeBtn).TextOptions.Alignment := taLeftJustify;
  29.     PointerTag := self;
  30.     ABitmap := TBitmap.Create;
  31.     ABitmap.Width := 16;
  32.     ABitmap.Height := 16;
  33. //    ABitmap.Canvas.Draw(0, 0, Icon);
  34.     DrawIconEx(ABitmap.Canvas.Handle, 0, 0, Icon.Handle, 16, 16, 0, 0, DI_NORMAL or DI_DEFAULTSIZE);
  35.     Button.Glyph := ABitmap;
  36.     ABitmap.Free;
  37.   end;
  38. end;
  39. procedure TMDIChild.FormDestroy(Sender: TObject);
  40. begin
  41.   MainMDIForm.fcButtonGroup1.ButtonItems.FindPointerTag(self).Free;
  42. end;
  43. procedure TMDIChild.FormActivate(Sender: TObject);
  44. begin
  45.   MainMDIForm.fcButtonGroup1.ButtonItems.FindPointerTag(self).Selected := True;
  46. end;
  47. end.