CtrlImg.pas
上传用户:daoqigc
上传日期:2021-04-20
资源大小:2795k
文件大小:6k
源码类别:

RichEdit

开发平台:

Delphi

  1. {*******************************************************}
  2. {                                                       }
  3. {       RichView                                        }
  4. {       DrawControl - function creating a bitmap and    }
  5. {       drawing the given control into it.              }
  6. {                                                       }
  7. {       Copyright (c) Sergey Tkachenko                  }
  8. {       svt@trichview.com                               }
  9. {       http://www.trichview.com                        }
  10. {                                                       }
  11. {*******************************************************}
  12. unit CtrlImg;
  13. interface
  14. {$I RV_Defs.inc}
  15. uses Windows, Classes, Controls, StdCtrls, Graphics, Forms, SysUtils,
  16.      ExtCtrls;
  17. function DrawButton(ctrl: TButton): TBitmap;
  18. function DrawEdit(ctrl: TEdit): TBitmap;
  19. function DrawMemo(ctrl: TMemo): TBitmap;
  20. function DrawPanel(ctrl: TPanel): TBitmap;
  21. function DrawControl(ctrl: TControl): TBitmap;
  22. implementation
  23. {------------------------------------------------------------------}
  24. procedure ForceHandle(aControl:TWinControl);
  25. var i : integer;
  26. begin
  27.   TWinCOntrol(aControl).Handle;
  28.   for i := 0 to aControl.ControlCount-1 do
  29.    if aControl.Controls[i] is TWinControl then
  30.      ForceHandle(TWinControl(aControl.Controls[i]));
  31. end;
  32. {------------------------------------------------------------------}
  33. function AllocBmp(ctrl: TControl): TBitmap;
  34. begin
  35.   Result        := TBitmap.Create;
  36.   Result.Width  := ctrl.Width;
  37.   Result.Height := ctrl.Height;
  38. end;
  39. {------------------------------------------------------------------}
  40. procedure DrawButton_(ctrl: TButton; Canvas: TCanvas; X,Y: Integer);
  41. var r: TRect;
  42. begin
  43.   r := Bounds(X,Y,ctrl.Width,ctrl.Height);
  44.   with Canvas do begin
  45.     DrawFrameControl(Handle, r, DFC_BUTTON, DFCS_BUTTONPUSH);
  46.     Font := ctrl.Font;
  47.     Brush.Style := bsClear;
  48.     DrawText(Handle, PChar(ctrl.Caption),-1,
  49.              r, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  50.   end;
  51. end;
  52. {------------------------------------------------------------------}
  53. function DrawButton(ctrl: TButton): TBitmap;
  54. begin
  55.   Result := AllocBmp(ctrl);
  56.   DrawButton_(ctrl, Result.Canvas, 0,0);
  57. end;
  58. {------------------------------------------------------------------}
  59. procedure DrawEditBack(Canvas: TCanvas; var r: TRect; Color: TColor;
  60.                        Ctl3D, Border: Boolean);
  61. begin
  62.   with Canvas do begin
  63.     Brush.Color := Color;
  64.     FillRect(r);
  65.     if Border then
  66.       if Ctl3D then
  67.         DrawEdge(Handle, r, EDGE_SUNKEN, BF_RECT or BF_ADJUST)
  68.       else
  69.         begin
  70.           with r do Rectangle(Left,Top,Right,Bottom);
  71.           InflateRect(r,-1,-1);
  72.         end;
  73.     InflateRect(r,-1,-1);
  74.   end;
  75. end;
  76. {------------------------------------------------------------------}
  77. procedure DrawEdit_(ctrl: TEdit; Canvas: TCanvas; X,Y: Integer);
  78. var r: TRect;
  79. begin
  80.   r := Bounds(X,Y,ctrl.Width,ctrl.Height);
  81.   with Canvas do begin
  82.     DrawEditBack(Canvas, r, ctrl.Color, ctrl.Ctl3D,
  83.                  ctrl.BorderStyle = bsSingle);
  84.     Font := ctrl.Font;
  85.     DrawText(Handle, PChar(ctrl.Text),-1,
  86.              r, DT_LEFT or DT_SINGLELINE or DT_EDITCONTROL);
  87.   end;
  88. end;
  89. {------------------------------------------------------------------}
  90. function DrawEdit(ctrl: TEdit): TBitmap;
  91. begin
  92.   Result := AllocBmp(ctrl);
  93.   DrawEdit_(ctrl, Result.Canvas, 0,0);
  94. end;
  95. {------------------------------------------------------------------}
  96. procedure DrawMemo_(ctrl: TMemo; Canvas: TCanvas; X,Y: Integer);
  97. var r: TRect;
  98.     flag: Integer;
  99. begin
  100.   r := Bounds(X,Y,ctrl.Width,ctrl.Height);
  101.   with Canvas do begin
  102.     DrawEditBack(Canvas, r, ctrl.Color, ctrl.Ctl3D,
  103.                  ctrl.BorderStyle = bsSingle);
  104.     Font := ctrl.Font;
  105.     case ctrl.Alignment of
  106.       taRightJustify:
  107.         flag := DT_RIGHT;
  108.       taCenter:
  109.         flag := DT_CENTER;
  110.       else
  111.         flag := DT_LEFT;
  112.     end;
  113.     DrawText(Handle, PChar(ctrl.Text),-1,
  114.              r, flag or DT_EDITCONTROL);
  115.   end;
  116. end;
  117. {------------------------------------------------------------------}
  118. function DrawMemo(ctrl: TMemo): TBitmap;
  119. begin
  120.   Result := AllocBmp(ctrl);
  121.   DrawMemo_(ctrl, Result.Canvas, 0, 0);
  122. end;
  123. {------------------------------------------------------------------}
  124. procedure DrawPanel_(ctrl: TPanel; Canvas: TCanvas; X,Y: Integer);forward;
  125. procedure DrawControl_(ctrl: TControl; Canvas: TCanvas; X,Y: Integer);
  126. begin
  127.   if ctrl is TButton then
  128.     DrawButton_(TButton(ctrl), Canvas, X, Y)
  129.   else if ctrl is TEdit then
  130.     DrawEdit_(TEdit(ctrl), Canvas, X, Y)
  131.   else if ctrl is TMemo then
  132.     DrawMemo_(TMemo(ctrl), Canvas, X, Y)
  133.   else if ctrl is TPanel then
  134.     DrawPanel_(TPanel(ctrl), Canvas, X, Y)
  135.   else if ctrl is TWinControl then begin
  136.     ForceHandle(TWinControl(ctrl));
  137.     TWinControl(ctrl).PaintTo(Canvas.Handle, X, Y);
  138.   end;
  139. end;
  140. {------------------------------------------------------------------}
  141. procedure DrawPanel_(ctrl: TPanel; Canvas: TCanvas; X,Y: Integer);
  142. var i: Integer;
  143. begin
  144.   ctrl.PaintTo(Canvas.Handle, X,Y);
  145.   for i := 0 to Ctrl.ControlCount-1 do
  146.     DrawControl_(Ctrl.Controls[i], Canvas, X+Ctrl.Controls[i].Left,Y+Ctrl.Controls[i].Top);
  147. end;
  148. {------------------------------------------------------------------}
  149. function DrawPanel(ctrl: TPanel): TBitmap;
  150. begin
  151.   Result := AllocBmp(ctrl);
  152.   DrawPanel_(ctrl, Result.Canvas, 0,0);
  153. end;
  154. {------------------------------------------------------------------}
  155. function DrawControl(ctrl: TControl): TBitmap;
  156. begin
  157.   Result := AllocBmp(ctrl);
  158.   DrawControl_(ctrl, Result.Canvas,0,0);
  159. end;
  160. {------------------------------------------------------------------}
  161. end.