home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue31 / cm20 / CM20.ZIP / Demo / cm_even.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-12-31  |  3.6 KB  |  147 lines
  1. unit cm_even;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ColMemo, ExtCtrls;
  8.  
  9. type
  10.   TFrmEventsDemo = class(TForm)
  11.     ColorMemo1: TColorMemo;
  12.     Label13: TLabel;
  13.     eFile: TEdit;
  14.     btnFile: TButton;
  15.     ODlg: TOpenDialog;
  16.     cbxDrawKey: TCheckBox;
  17.     cbxDraw: TCheckBox;
  18.     gbxDraw: TGroupBox;
  19.     eSearch: TEdit;
  20.     lblSearch: TLabel;
  21.     pnlDrawKey: TPanel;
  22.     cbxBold: TCheckBox;
  23.     cbxItalic: TCheckBox;
  24.     cbxUnderline: TCheckBox;
  25.     cbxFont: TComboBox;
  26.     lblFonts: TLabel;
  27.     procedure btnFileClick(Sender: TObject);
  28.     procedure ColorMemo1DrawKey(Canvas: TCanvas; const PKey: String;
  29.       Rect: TRect; KColor: TColor);
  30.     procedure cbxChange(Sender: TObject);
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure cbxFontChange(Sender: TObject);
  33.     procedure ColorMemo1Draw(Sender: TObject; FromPos: PChar;
  34.       var A: array of TKeyDescr; var ItemsCount: Integer);
  35.     procedure cbxDrawKeyClick(Sender: TObject);
  36.     procedure cbxDrawClick(Sender: TObject);
  37.     procedure eSearchExit(Sender: TObject);
  38.     procedure eSearchKeyPress(Sender: TObject; var Key: Char);
  39.   private
  40.     { Private declarations }
  41.   public
  42.     { Public declarations }
  43.     procedure LoadIt;
  44.   end;
  45.  
  46. var
  47.   FrmEventsDemo: TFrmEventsDemo;
  48.  
  49. implementation
  50.  
  51. {$R *.DFM}
  52.  
  53. procedure TFrmEventsDemo.btnFileClick(Sender: TObject);
  54. begin
  55.      if ODlg.Execute then
  56.      begin
  57.           eFile.Text:=ODlg.FileName;
  58.           LoadIt;
  59.      end;
  60. end;
  61.  
  62. procedure TFrmEventsDemo.LoadIt;
  63. begin
  64.      try
  65.         ColorMemo1.Lines.LoadFromFile(eFile.Text);
  66.      except
  67.      end;
  68. end;
  69.  
  70. procedure TFrmEventsDemo.ColorMemo1DrawKey(Canvas: TCanvas;
  71.   const PKey: String; Rect: TRect; KColor: TColor);
  72. var OldFS: TFontStyles;
  73. begin
  74.   OldFS := Canvas.Font.Style;
  75.   if cbxDrawKey.Checked then begin
  76.      if cbxBold.Checked then 
  77.         Canvas.Font.Style := Canvas.Font.Style + [fsBold];
  78.      if cbxItalic.Checked then 
  79.         Canvas.Font.Style := Canvas.Font.Style + [fsItalic];
  80.      if cbxUnderline.Checked then 
  81.         Canvas.Font.Style := Canvas.Font.Style + [fsUnderline];
  82.   end;
  83.      
  84.   Canvas.TextOut( Rect.Left, Rect.Top, PKey);
  85.   Canvas.Font.Style := OldFS;
  86. end;
  87.  
  88. procedure TFrmEventsDemo.cbxChange(Sender: TObject);
  89. begin
  90.   ColorMemo1.Refresh;
  91. end;
  92.  
  93. procedure TFrmEventsDemo.FormCreate(Sender: TObject);
  94. begin
  95.      cbxFont.Items := Screen.Fonts;
  96. end;
  97.  
  98. procedure TFrmEventsDemo.cbxFontChange(Sender: TObject);
  99. begin
  100.   ColorMemo1.Font.Name := cbxFont.Text;
  101. end;
  102.  
  103. procedure TFrmEventsDemo.ColorMemo1Draw(Sender: TObject; FromPos: PChar;
  104.   var A: array of TKeyDescr; var ItemsCount: Integer);
  105. var Str :String;
  106.     i : integer;
  107. begin
  108.   Str := StrPas(FromPos);
  109.   i := Pos(eSearch.Text, Str);
  110.   if i<>0 then begin
  111.     A[0].Left := i-1;
  112.     A[0].Right := i + Length(eSearch.Text) -1;
  113.     A[0].KeyColor := clBlue;
  114.     A[0].ZOrder := 1;
  115.   end;
  116.   ItemsCount := 1;
  117. end;
  118.  
  119. procedure TFrmEventsDemo.cbxDrawKeyClick(Sender: TObject);
  120. begin
  121.   cbxBold.Enabled := cbxDrawKey.Checked;
  122.   cbxItalic.Enabled := cbxDrawKey.Checked;
  123.   cbxUnderline.Enabled := cbxDrawKey.Checked;
  124.   cbxFont.Enabled := cbxDrawKey.Checked;
  125.   ColorMemo1.Refresh;
  126. end;
  127.  
  128.  
  129. procedure TFrmEventsDemo.cbxDrawClick(Sender: TObject);
  130. begin
  131.   ColorMemo1.ColorRules.Items[4].Enabled := cbxDraw.Checked;
  132.   eSearch.Enabled := cbxDraw.Checked;
  133.   ColorMemo1.Refresh;
  134. end;
  135.  
  136. procedure TFrmEventsDemo.eSearchExit(Sender: TObject);
  137. begin
  138.     ColorMemo1.Refresh;
  139. end;
  140.  
  141. procedure TFrmEventsDemo.eSearchKeyPress(Sender: TObject; var Key: Char);
  142. begin
  143.   if Key=#13 then ColorMemo1.Refresh;
  144. end;
  145.  
  146. end.
  147.