home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D / WIDGETS.ZIP / WdgEdt.pas < prev    next >
Pascal/Delphi Source File  |  1998-07-20  |  8KB  |  300 lines
  1. (*
  2.  
  3.             TWidgetEditor: Component Editor for TWidget
  4.             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  5.  
  6.                Copyright 1998 by Robert R. Marsh, SJ
  7.           and the British Province of the Society of Jesus
  8.  
  9.                            rrm@sprynet.com
  10.                  http://home.sprynet.com/sprynet/rrm
  11.  
  12.    TWidgetEditor just makes it easier to set the glyph of a TWidget.
  13.  
  14.    The Widget components are released as freeware with no promise
  15.    expressed or implied about their suitability for any purpose. Use
  16.    them at your own risk. Please let me know though of any problems you
  17.    encounter.
  18.  
  19.    Thanks to Ray Konopka for some of the code for converting colors.
  20.    
  21. *)
  22.  
  23. unit WdgEdt;
  24.  
  25. interface
  26.  
  27. uses
  28.   Windows,
  29.   Classes,
  30.   Graphics,
  31.   Controls,
  32.   Forms,
  33.   StdCtrls,
  34.   Grids,
  35.   ExtCtrls,
  36.   DsgnIntf, ComCtrls;
  37.  
  38. type
  39.   TWidgetEditor = class(TComponentEditor)
  40.     function GetVerbCount: integer; override;
  41.     function GetVerb(Index: integer): string; override;
  42.     procedure ExecuteVerb(Index: integer); override;
  43.   end;
  44.  
  45. type
  46.   TWidgetEditDlg = class(TForm)
  47.     ComboBox1: TComboBox;
  48.     Bold: TCheckBox;
  49.     Italic: TCheckBox;
  50.     GlyphGrid: TStringGrid;
  51.     FontLabel: TLabel;
  52.     Button1: TButton;
  53.     Button2: TButton;
  54.     Panel1: TPanel;
  55.     ColorGrid: TStringGrid;
  56.     UpDown1: TUpDown;
  57.     UpDown2: TUpDown;
  58.     Image: TImage;
  59.     procedure FormCreate(Sender: TObject);
  60.     procedure ComboBox1Change(Sender: TObject);
  61.     procedure ItalicClick(Sender: TObject);
  62.     procedure BoldClick(Sender: TObject);
  63.     procedure GlyphGridClick(Sender: TObject);
  64.     procedure ColorGridDrawCell(Sender: TObject; Col, Row: longint;
  65.       Rect: TRect; State: TGridDrawState);
  66.     procedure ColorGridClick(Sender: TObject);
  67.     procedure GlyphGridSelectCell(Sender: TObject; Col, Row: longint;
  68.       var CanSelect: Boolean);
  69.     procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
  70.     procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
  71.   private
  72.     { Private declarations }
  73.     Glyph: char;
  74.     OffsetLeft: integer;
  75.     OffSetTop: integer;
  76.   public
  77.     { Public declarations }
  78.     procedure DrawPanel;
  79.   end;
  80.  
  81. procedure Register;
  82.  
  83. implementation
  84.  
  85. uses
  86.   Widget;
  87.  
  88. {$R *.DFM}
  89.  
  90. {$R WIDGET.DCR}
  91.  
  92. procedure Register;
  93. begin
  94.   RegisterComponents('IHSoftware', [TWidget]);
  95.   RegisterComponentEditor(TWidget, TWidgetEditor);
  96. end;
  97.  
  98. const
  99.   Colors : array [0..15] of TColor =
  100.   (clBlack, clMaroon, clGreen, clOlive,
  101.    clNavy, clPurple, clTeal, clGray,
  102.    clSilver, clRed, clLime, clYellow,
  103.    clBlue, clFuchsia, clAqua, clWhite);
  104.  
  105. function TWidgetEditor.GetVerbCount: integer;
  106. begin
  107.   Result:=1;
  108. end;
  109.  
  110. function TWidgetEditor.GetVerb(Index: integer): string;
  111. begin
  112.   Result:='Edit &Widget';
  113. end;
  114.  
  115. function IndexFromColor(C: TColor): integer;
  116. var
  117.   i: integer;
  118. begin
  119.   i:=0;
  120.   while (i < 16) and (ColorToRGB(Colors[i]) <> ColorToRGB(C)) do
  121.     inc(i);
  122.   if i=16 then
  123.     Result:=0
  124.   else
  125.     Result:=i;
  126. end;
  127.  
  128. procedure TWidgetEditor.ExecuteVerb(Index: integer);
  129. var
  130.   D: TWidgetEditDlg;
  131. begin
  132.   D:=TWidgetEditDlg.Create(Application);
  133.   try
  134.     with Component as TWidget do
  135.     begin
  136.     D.Caption:=Owner.Name + '.' + Name + D.Caption;
  137.     D.GlyphGrid.Font.Name:=Font.Name;
  138.     D.ComboBox1.ItemIndex:=D.ComboBox1.Items.IndexOf(Font.Name);
  139.     D.Bold.Checked:=fsBold in Font.Style;
  140.     D.Italic.Checked:=fsItalic in Font.Style;
  141.     D.Image.Picture.Bitmap:=Image;
  142.     D.Glyph:=Glyph;
  143.     D.OffsetLeft:=OffsetLeft;
  144.     D.OffsetTop:=OffsetTop;
  145.     D.UpDown1.Position:=-OffsetTop;
  146.     D.UpDown2.Position:=OffsetLeft;
  147.     D.GlyphGrid.Row:=ord(Glyph) div 16;
  148.     D.GlyphGrid.Col:=ord(Glyph) mod 16;
  149.     D.ColorGrid.Col:=IndexFromColor(Font.Color);
  150.     end;
  151.     if D.ShowModal = mrOK then
  152.     begin
  153.       with Component as TWidget do
  154.       begin
  155.         Font.Name:=D.GlyphGrid.Font.Name;
  156.         Font.Color:=D.GlyphGrid.Font.Color;
  157.         Font.Style:=D.GlyphGrid.Font.Style;
  158.         Glyph:=D.Glyph;
  159.         Image:=D.Image.Picture.Bitmap;;
  160.         OffsetLeft:=D.OffsetLeft;
  161.         OffsetTop:=D.OffsetTop;
  162.       end;
  163.       Designer.Modified;
  164.     end;
  165.   finally
  166.     D.Free;
  167.   end;
  168. end;
  169.  
  170. procedure TWidgetEditDlg.FormCreate(Sender: TObject);
  171. var
  172.   vCol, vRow: longint;
  173. begin
  174.   ComboBox1.Items:=Screen.Fonts;
  175.   with GlyphGrid do
  176.   begin
  177.     DefaultColWidth := (ClientWidth div 16) - GridLineWidth;
  178.     DefaultRowHeight := (ClientHeight div 16) - GridLineWidth;
  179.     for vRow:=0 to 15 do
  180.       for vCol:=0 to 15 do
  181.         Cells[vCol,vRow]:=chr(vRow*16 + vCol);
  182.   end;
  183. end;
  184.  
  185. procedure TWidgetEditDlg.ComboBox1Change(Sender: TObject);
  186. begin
  187.   GlyphGrid.Font.Name:=ComboBox1.Items[ComboBox1.ItemIndex];
  188.   DrawPanel;
  189. end;
  190.  
  191. procedure TWidgetEditDlg.ItalicClick(Sender: TObject);
  192. var
  193.   fs: TFontStyles;
  194. begin
  195.   fs:=GlyphGrid.Font.Style;
  196.   if Italic.Checked then
  197.     Include(fs,fsItalic)
  198.   else
  199.     Exclude(fs,fsItalic);
  200.   GlyphGrid.Font.Style:=fs;
  201.   DrawPanel;
  202. end;
  203.  
  204. procedure TWidgetEditDlg.BoldClick(Sender: TObject);
  205. var
  206.   fs: TFontStyles;
  207. begin
  208.   fs:=GlyphGrid.Font.Style;
  209.   if Bold.Checked then
  210.     Include(fs,fsBold)
  211.   else
  212.     Exclude(fs,fsBold);
  213.   GlyphGrid.Font.Style:=fs;
  214.   DrawPanel;
  215. end;
  216.  
  217. procedure TWidgetEditDlg.GlyphGridClick(Sender: TObject);
  218. begin
  219.   with Panel1 do
  220.   begin
  221.     Font.Name:=GlyphGrid.Font.Name;
  222.     Font.Height:=ClientHeight-4;
  223.     Glyph:=GlyphGrid.Cells[GlyphGrid.Col,GlyphGrid.Row][1];
  224.     DrawPanel;
  225.   end;
  226. end;
  227.  
  228. procedure TWidgetEditDlg.ColorGridDrawCell(Sender: TObject; Col,
  229.   Row: longint; Rect: TRect; State: TGridDrawState);
  230. begin
  231.   ColorGrid.Canvas.Brush.Color:=Colors[Col];
  232.   ColorGrid.Canvas.FillRect(Rect);
  233. end;
  234.  
  235. procedure TWidgetEditDlg.ColorGridClick(Sender: TObject);
  236. begin
  237.   GlyphGrid.Font.Color:=Colors[ColorGrid.Col];
  238.   DrawPanel;
  239. end;
  240.  
  241. // A design mistake!! This routine has to parallel
  242. // TWidget.DrawWidget or else the drawing is off.
  243. procedure TWidgetEditDlg.DrawPanel;
  244. var
  245.   Y: integer;
  246.   R: TRect;
  247.   RB: TRect;
  248. begin
  249.   with Panel1 do
  250.   begin
  251.     Canvas.Handle := GetWindowDC(Handle);
  252.     try
  253.       Canvas.Font:=GlyphGrid.Font;
  254.       Canvas.Brush.Color:=clBtnFace;
  255.       SetBkMode(Canvas.Handle,TRANSPARENT);
  256.       Y:=GetSystemMetrics(SM_CYSIZE);
  257.       R:=Bounds((ClientWidth-(Y-2)) div 2, (ClientHeight - (Y-4)) div 2, Y-2, Y-4);
  258.       DrawFrameControl(Canvas.Handle, R, DFC_BUTTON, DFCS_BUTTONPUSH);
  259.       // define a smaller area to put the glyph in
  260.       InflateRect(R, -2, -2);
  261.       OffsetRect(R,OffsetLeft, OffsetTop);
  262.         if Image.Picture.Bitmap.Empty then
  263.         begin
  264.           // choose a font size to fit
  265.           Canvas.Font.Height := (R.Top - R.Bottom - 1);
  266.           DrawText(Canvas.Handle, pchar(string(Glyph)), 1, R, DT_CENTER or DT_VCENTER or DT_NOCLIP);
  267.          end
  268.         else
  269.         begin
  270.           RB:=Image.Canvas.ClipRect;
  271.           Canvas.BrushCopy(R, Image.Picture.Bitmap, RB, Image.Picture.Bitmap.TransparentColor);
  272.         end;
  273.     finally
  274.       ReleaseDC(Handle, Canvas.Handle);
  275.       Canvas.Handle := 0;
  276.     end;
  277.  
  278.   end;
  279. end;
  280.  
  281. procedure TWidgetEditDlg.GlyphGridSelectCell(Sender: TObject; Col,
  282.   Row: longint; var CanSelect: Boolean);
  283. begin
  284.   DrawPanel;
  285. end;
  286.  
  287. procedure TWidgetEditDlg.UpDown1Click(Sender: TObject; Button: TUDBtnType);
  288. begin
  289.   OffsetTop:=-UpDown1.Position;
  290.   DrawPanel;
  291. end;
  292.  
  293. procedure TWidgetEditDlg.UpDown2Click(Sender: TObject; Button: TUDBtnType);
  294. begin
  295.   OffsetLeft:=UpDown2.Position;
  296.   DrawPanel;
  297. end;
  298.  
  299. end.
  300.