controls/fontdialog/KOLMHFontDialog.pas

   1 unit KOLMHFontDialog;
   2 //  MHFontDialog Êîìïîíåíò (MHFontDialog Component)
   3 //  Àâòîð (Author): Æàðîâ Äìèòðèé (Zharov Dmitry) aka Ãýíäàëüô (Gandalf)
   4 //  Äàòà ñîçäàíèÿ (Create date): 19-íîÿ(nov)-2002
   5 //  Äàòà êîððåêöèè (Last correction Date): 15-àâã(aug)-2003
   6 //  Âåðñèÿ (Version): 1.3
   7 //  EMail: Gandalf@kol.mastak.ru
   8 //  WWW: http://kol.mastak.ru
   9 //  Áëàãîäàðíîñòè (Thanks):
  10 //    Vladimir Kladov
  11 //    Alexander Pravdin
  12 //    Dominiko-m
  13 //    Kiril Krasnov
  14 //    Ajax Talamned
  15 //  Íîâîå â (New in):
  16 //  V1.3 (KOL 1.80, Delphi 7)
  17 //  [+] Device âåðíóë (Return Device property) <Thanks to Ajax Talamned> [KOLnMCK]
  18 //  [-] Óáðàë fdShowHelp fdApplyButton (Delete fdShowHelp fdApplyButton) [KOLnMCK]
  19 //  [*] Ïåðåèìåíîâàë  MaxSize,MinSize -> MaxFontSize,MinFontSize, êàê â VCL (Rename MaxSize,MinSize -> MaxFontSize,MinFontSize as in VCL) [KOLnMCK]
  20 //  [+] Äîáàâèë fdInitFont (Add fdInitFont) [KOLnMCK]
  21 //  [+] È äðóãîå (Add others) [KOLnMCK]
  22 //
  23 //  V1.21 (KOL 1.79, Delphi 7)
  24 //  [+] Ñâîéñòâî Options (Options property) <Thanks to Ajax Talamned> [KOLnMCK]
  25 //
  26 //  V1.2
  27 //  [-] Óòå÷êà ïàìÿòè ëèêâèäèðîâàíà (Memory leak fixed) <Thanks to dominiko-m> [KOL]
  28 //
  29 //  V1.11
  30 //  [+] Ïîääåðæêà D7 (D7 Support) [KOLnMCK]
  31 //
  32 //  V1.1
  33 //  [+] Ïîääåðæêà D6 (D6 Support) <Thanks to Alexander Pravdin> [KOLnMCK]
  34 //  [!] Íåâåðíîå çàí÷åíèå InitFont (Incorrect InitFont) <Thanks to Kiril Krasnov, Dominiko-m> [KOL]
  35 //  [N] KOLnMCK>=1.43
  36 //
  37 //  Ñïèñîê äåë (To-Do list):
  38 //  2. Good Default Values
  39 //  3. Optimize
  40 //  4. Asm
  41 // 19. Add InitDialog Event
  42 // 20. Printer DC not realized
  43 // 21. Àññåìáëåð (Asm)
  44 // 22. Îïòèìèçèðîâàòü (Optimize)
  45 // 23. Ïîä÷èñòèòü (Clear Stuff)
  46 // 24. Îøèáêè (Errors)
  47 //1) Ìîæåò InitFont çàìåíèòü íà Font, ò.å. â êà÷åñòâå èíèòà èñïîëüçóåòñÿ
  48 //òåêóùèé?
  49 //2) Ìîæåò óáðàòü fdWysiwyg - ýòî âíäá êîìáèíàöèÿ ñòèëåé (íî óäîáíàÿ)
  50
  51
  52 interface
  53
  54 uses
  55   KOL, Windows, ShellAPI, CommDlg, Messages;
  56
  57 type
  58   TFontDialogOption = (fdAnsiOnly, fdTrueTypeOnly, fdEffects, fdFixedPitchOnly,
  59     fdForceFontExist, fdNoFaceSel, fdNoOEMFonts, fdNoSimulations,
  60     fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts, {fdShowHelp,}
  61     fdWysiwyg, fdLimitSize, fdScalableOnly,{ fdApplyButton,} fdInitFont);
  62   TFontDialogOptions = set of TFontDialogOption;
  63
  64   TFontDialogDevice = (fdBoth, fdScreen, fdPrinter);
  65   TFontIgnoreInit = (fiiName, fiiStyle, fiiSize);
  66   TFontIgnoreInits = set of TFontIgnoreInit;
  67
  68   PMHFontDialog = ^TMHFontDialog;
  69   TKOLMHFontDialog = PMHFontDialog;
  70
  71   TOnMHFontDApply = procedure(Sender: PMHFontDialog) of object;
  72   TOnMHFontDHelp = procedure(Sender: PMHFontDialog) of object;
  73
  74   TMHFontDialog = object(TObj)
  75   private
  76     FControl: PControl;
  77     //     FShowEffects:Boolean;
  78     //     FMinSize:Integer;
  79     //     FMaxSize:Integer;
  80          //FFlags:DWORD;
  81     //     FOptions: TFontDialogOptions;
  82     //     FUseMinMaxSize:Boolean;
  83     //     FDevice:TFontDialogDevice;
  84     //     FIgnoreInits:TFontIgnoreInits;
  85     FInitFont: PGraphicTool;
  86     //     FUseInitFont:Boolean;
  87     //     FForceFontExist:Boolean;
  88 //    LastMHFontDialog: PMHFontDialog;
  89 //    FOnHelp: TOnMHFontDHelp;
  90 //    FOnApply: TOnMHFontDApply;
  91     FHandle: THandle;
  92   public
  93     Font: PGraphicTool;
  94     Device: TFontDialogDevice;
  95     MinFontSize: Integer;
  96     MaxFontSize: Integer;
  97     Options: TFontDialogOptions;
  98     OnHelp: TOnMHFontDHelp;// read FOnHelp write FOnHelp;
  99     OnApply: TOnMHFontDApply;// read FOnApply write FOnApply;
 100     //     property ShowEffects:Boolean read FShowEffects write FShowEffects;
 101     //     property MinSize:Integer read FMinSize write FMinSize;
 102     //     property MaxSize:Integer read FmaxSize write FMaxSize;
 103     //     property UseMinMaxSize:Boolean read FUseMinMaxSize write FUseMinMaxSize;
 104     //     property Device:TFontDialogDevice;// read FDevice write FDevice;
 105     //     property IgnoreInits:TFontIgnoreInits read FIgnoreInits write FIgnoreInits;
 106     property InitFont: PGraphicTool read FInitFont;
 107     //     property UseInitFont:Boolean read FUseInitFont write FUseInitFont;
 108     //     property ForceFontExist:Boolean read FForceFontExist write FForceFontExist;
 109
 110          //Ìîå -- :)
 111     //    property Options: TFontDialogOptions read FOptions write FOptions default [fdEffects];
 112
 113          //property Flags:DWORD read FFlags write FFlags;
 114 //    property OnHelp: TOnMHFontDHelp read FOnHelp write FOnHelp;
 115 //    property OnApply: TOnMHFontDApply read FOnApply write FOnApply;
 116     property Handle: THandle read FHandle; // write FHandle;
 117     function Execute: Boolean;
 118     destructor Destroy; virtual;
 119   end;
 120
 121 var
 122   HelpMessageIndex: UINT;
 123 //  MHFontDialogNow: PMHFontDialog;
 124 const
 125   IDAPPLYBTN = $402;
 126
 127 function NewMHFontDialog(AParent: PControl): PMHFontDialog;
 128
 129 implementation
 130
 131 function WndProcMHFontDialog(Control: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
 132 var
 133   Self:PMHFontDialog;
 134 begin
 135   Result := False;
 136   Self:=Pointer(GetProp(Msg.wParam, ID_SELF));
 137   if Msg.message = HelpMessageIndex then
 138   begin
 139     if Assigned(Self.OnHelp) then
 140       Self.OnHelp(@Self);
 141     Rslt := 0;
 142     Result := True;
 143   end;
 144 end;
 145
 146 function NewMHFontDialog(AParent: PControl): PMHFontDialog;
 147 begin
 148   New(Result, Create);
 149   Result.FControl := AParent;
 150   Result.Font := NewFont;
 151   Result.FInitFont := NewFont;
 152 //  Result.Device := fdScreen;
 153   AParent.AttachProc(WndProcMHFontDialog);
 154 end;
 155
 156 function MHKOLFontDialogHook(Wnd: HWnd; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
 157 const
 158   IDCOLORCMB = $473;
 159 var
 160   TMPLogFont: TLogFont;
 161   i: Integer;
 162   Self:PMHFontDialog;
 163   zzz:PChooseFont;
 164 begin
 165   Result := 0;
 166   Self:=Pointer(GetProp(Wnd, ID_SELF));
 167   case Msg of
 168     WM_INITDIALOG:
 169     begin
 170       Self:=PMHFontDialog(PChooseFont(LParam).lCustData);
 171       SetProp( Wnd, ID_SELF, THandle(Self) );
 172       Self.FHandle:=Wnd;
 173 //      MHFontDialogNow.FHandle := Wnd;
 174     end;
 175
 176     WM_COMMAND:
 177       begin
 178         if (HiWord(wParam) = BN_CLICKED) and (LoWord(wParam) = IDAPPLYBTN) then
 179         begin
 180
 181           SendMessage(Wnd, WM_CHOOSEFONT_GETLOGFONT, 0, LongInt(@TMPLogFont));
 182           Self.Font.LogFontStruct := TMPLogFont;
 183           I := SendDlgItemMessage(Wnd, IDCOLORCMB, CB_GETCURSEL, 0, 0);
 184
 185           if I <> CB_ERR then
 186             Self.Font.Color := SendDlgItemMessage(Wnd, IDCOLORCMB, CB_GETITEMDATA, I, 0);
 187
 188           if Assigned(Self.OnApply) then
 189             Self.OnApply(@Self);
 190           Result := 1;
 191         end;
 192       end;
 193   end; //case
 194 end;
 195
 196 function TMHFontDialog.Execute: Boolean;
 197 const
 198   FontOptions: array[TFontDialogOption] of Integer = (
 199     CF_ANSIONLY, CF_TTONLY, CF_EFFECTS, CF_FIXEDPITCHONLY, CF_FORCEFONTEXIST,
 200     CF_NOFACESEL, CF_NOOEMFONTS, CF_NOSIMULATIONS, CF_NOSIZESEL,
 201     CF_NOSTYLESEL, CF_NOVECTORFONTS, {CF_SHOWHELP,}
 202     CF_WYSIWYG or CF_BOTH or CF_SCALABLEONLY, CF_LIMITSIZE,
 203     CF_SCALABLEONLY, {CF_APPLY,} CF_INITTOLOGFONTSTRUCT);
 204   Device2Flag: array[TFontDialogDevice] of Integer = (CF_BOTH,
 205     CF_SCREENFONTS,
 206     CF_PRINTERFONTS);
 207 var
 208   TMPCF: TChooseFont;
 209   TMPLogFont: TLogFont;
 210   i: Integer;
 211   Option: TFontDialogOption;
 212 begin
 213   TMPCF.lStructSize := Sizeof(TMPCF);
 214   if assigned(Applet) then
 215     TMPCF.hWndOwner := Applet.Handle
 216   else
 217     TMPCF.hWndOwner := 0;
 218   TMPCF.hInstance := 0;
 219   TMPCF.Flags := CF_ENABLEHOOK;
 220
 221   TMPLogFont := InitFont.LogFontStruct;
 222   TMPCF.lpLogFont := @TMPLogFont;
 223
 224   TMPCF.hDC := 0; // None Full Correct
 225
 226   TMPCF.nSizeMin := MinFontSize;
 227   TMPCF.nSizeMax := MaxFontSize;
 228
 229   TMPCF.rgbColors := InitFont.Color;
 230
 231   TMPCF.Flags := MakeFlags(@Options, FontOptions) or CF_ENABLEHOOK;
 232   if Assigned(OnApply) then
 233     TMPCF.Flags := TMPCF.Flags or CF_APPLY;
 234   if Assigned(OnHelp) then
 235     TMPCF.Flags := TMPCF.Flags or CF_SHOWHELP;
 236   TMPCF.Flags := TMPCF.Flags or Device2Flag[Device];
 237
 238   TMPCF.lpfnHook := MHKOLFontDialogHook;
 239
 240   TMPCF.lCustData:=DWord(@Self);
 241
 242 //  LastMHFontDialog := MHFontDialogNow;
 243 //  MHFontDialogNow := @Self;
 244
 245   Result := ChooseFont(TMPCF);
 246
 247   if Result then
 248   begin
 249     Font.LogFontStruct := TMPLogFont;
 250     Font.Color := TMPCF.rgbColors;
 251   end;
 252 //  MHFontDialogNow := LastMHFontDialog;
 253 //  LastMHFontDialog := nil;
 254 end;
 255
 256 destructor TMHFontDialog.Destroy;
 257 begin
 258   Font.Free;
 259   FInitFont.Free;
 260   inherited;
 261 end;
 262
 263 begin
 264   HelpMessageIndex := RegisterWindowMessage(HELPMSGSTRING);
 265 end.
 266