HintWindow.pas

   1 unit HintWindow;
   2
   3 interface
   4
   5 uses
   6         Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   7         GikoSystem;
   8
   9 type
  10         TGikoPopupType = (gptRaw, gptThread);
  11
  12         TResPopup = class(THintWindow)
  13         private
  14                 FTitle: string;
  15                 FResList: TList;
  16                 FPopupType: TGikoPopupType;
  17         protected
  18                 procedure Paint; override;
  19         public
  20                 constructor Create(AOwner: TComponent); override;
  21                 destructor Destroy; override;
  22                 procedure Add(AHeader: string; ABody: string);
  23                 procedure ClearAllRes;
  24                 function ResCount: Integer;
  25                 function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
  26                 property Title: string read FTitle write FTitle;
  27                 property PopupType: TGikoPopupType read FPopupType write FPopupType;
  28         end;
  29
  30         PResDataRec = ^TResDataRec;
  31         TResDataRec = record
  32                 FHeader: string;
  33                 FHeaderHeight: Integer;
  34                 FBody: string;
  35                 FBodyHeight: Integer;
  36         end;
  37
  38 implementation
  39
  40 const
  41         BODY_INDENT = 5;                //Body\95\94\95ª\82Ì\83C\83\93\83f\83\93\83g\95\9d
  42         TITLE_SPACE = 8;                //\83^\83C\83g\83\8b\82Æ\96{\95¶\8aÔ\82Ì\8d\82\82³
  43         RES_SPACE = 8;                  //\83\8c\83X\8aÔ\8bó\94\92\82Ì\8d\82\82³
  44         HEADER_SPACE = 4;               //\83w\83b\83_\82Æ\96{\95¶\8aÔ\82Ì\8d\82\82³
  45
  46 constructor TResPopup.Create(AOwner: TComponent);
  47 begin
  48         inherited Create(AOwner);
  49         FResList := TList.Create;
  50 end;
  51
  52 destructor TResPopup.Destroy;
  53 begin
  54         ClearAllRes;
  55         FResList.Free;
  56         inherited Destroy;
  57 end;
  58
  59 procedure TResPopup.Paint;
  60 var
  61         R: TRect;
  62         i: Integer;
  63         ResData: PResDataRec;
  64         ARect: TRect;
  65 begin
  66         R := ClientRect;
  67         Inc(R.Left, 2);
  68         Inc(R.Top, 2);
  69         Canvas.Font.Color := Font.Color;
  70         Canvas.Font.Name := Font.Name;
  71         Canvas.Font.Size := Font.Size;
  72         if FPopupType = gptRaw then begin
  73                 Canvas.Font.Style := [];
  74                 DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX);
  75         end else begin
  76                 if FTitle <> '' then begin
  77                         Canvas.Font.Style := [fsBold];
  78                         DrawText(Canvas.Handle, PChar(FTitle), -1, R,
  79                                                          DT_LEFT or DT_NOPREFIX);
  80                         ARect := Rect(0, 0, 0, 0);
  81                         DrawText(Canvas.Handle, PChar(FTitle), -1, ARect,
  82                                                          DT_CALCRECT or DT_LEFT or DT_NOPREFIX);
  83                         R.Top := R.Top + ARect.Bottom + TITLE_SPACE;
  84                 end;
  85                 for i := 0 to FResList.Count - 1 do begin
  86                         if i <> 0 then
  87                                 R.Top := R.Top + RES_SPACE;
  88                         ResData := FResList[i];
  89                         //Header
  90                         Canvas.Font.Style := [fsBold];
  91                         DrawText(Canvas.Handle, PChar(ResData.FHeader), -1, R,
  92                                                          DT_LEFT or DT_NOPREFIX);
  93                         R.Top := R.Top + ResData.FHeaderHeight;
  94                         //\83X\83y\81[\83X
  95                         R.Top := R.Top + HEADER_SPACE;
  96                         //Body
  97                         Canvas.Font.Style := [];
  98                         R.Left := R.Left + BODY_INDENT;
  99                         DrawText(Canvas.Handle, PChar(ResData.FBody), -1, R,
 100                                                          DT_LEFT or DT_NOPREFIX);
 101                         R.Top := R.Top + ResData.FBodyHeight;
 102                         R.Left := R.Left - BODY_INDENT;
 103                 end;
 104         end;
 105 end;
 106
 107 function TResPopup.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
 108 var
 109         i: Integer;
 110         ARect: TRect;
 111         ResData: PResDataRec;
 112 begin
 113         Result := Rect(0, 0, 0, 0);
 114         Canvas.Font.Name := Font.Name;
 115         Canvas.Font.Size := Font.Size;
 116         if FPopupType = gptRaw then begin
 117                 Canvas.Font.Style := [fsBold];
 118                 Result := Rect(0, 0, MaxWidth, 0);
 119                 DrawText(Canvas.Handle, PChar(AHint), -1, Result,
 120                                                  DT_CALCRECT or DT_LEFT or DT_NOPREFIX);
 121         end else begin
 122                 //Title
 123                 if FTitle <> '' then begin
 124                         Canvas.Font.Style := [fsBold];
 125                         ARect := Rect(0, 0, MaxWidth, 0);
 126                         DrawText(Canvas.Handle, PChar(FTitle), -1, ARect,
 127                                                          DT_CALCRECT or DT_LEFT or DT_NOPREFIX);
 128                         if Result.Right < ARect.Right then
 129                                 Result.Right := ARect.Right;
 130                         Result.Bottom := Result.Bottom + ARect.Bottom + TITLE_SPACE;
 131                 end;
 132                 for i := 0 to FResList.Count - 1 do begin
 133                         if i <> 0 then
 134                                 Result.Bottom := Result.Bottom + RES_SPACE;
 135                         ResData := FResList[i];
 136                         //Header
 137                         Canvas.Font.Style := [fsBold];
 138                         ARect := Rect(0, 0, MaxWidth, 0);
 139                         DrawText(Canvas.Handle, PChar(ResData.FHeader), -1, ARect,
 140                                                          DT_CALCRECT or DT_LEFT or DT_NOPREFIX);
 141                         if Result.Right < ARect.Right then
 142                                 Result.Right := ARect.Right;
 143                         Result.Bottom := Result.Bottom + ARect.Bottom;
 144                         ResData.FHeaderHeight := ARect.Bottom;
 145                         //\83X\83y\81[\83X
 146                         Result.Bottom := Result.Bottom + HEADER_SPACE;
 147                         //Body
 148                         Canvas.Font.Style := [];
 149                         ARect := Rect(0, 0, MaxWidth, 0);
 150                         DrawText(Canvas.Handle, PChar(ResData.FBody), -1, ARect,
 151                                                          DT_CALCRECT or DT_LEFT or DT_NOPREFIX);
 152                         if Result.Right < (ARect.Right + BODY_INDENT) then
 153                                 Result.Right := ARect.Right + BODY_INDENT;
 154                         Result.Bottom := Result.Bottom + ARect.Bottom;
 155                         ResData.FBodyHeight := ARect.Bottom;
 156                 end;
 157         end;
 158         Inc(Result.Right, 6);
 159         Inc(Result.Bottom, 2);
 160 end;
 161
 162 procedure TResPopup.Add(AHeader: string; ABody: string);
 163 var
 164         ResData: PResDataRec;
 165 begin
 166         New(ResData);
 167         ResData.FHeader := AHeader;
 168         ResData.FHeaderHeight := 0;
 169         ResData.FBody := ABody;
 170         ResData.FBodyHeight := 0;
 171         FResList.Add(ResData);
 172 end;
 173
 174 procedure TResPopup.ClearAllRes;
 175 var
 176         i: Integer;
 177 begin
 178         for i := 0 to FResList.Count - 1 do
 179                 Dispose(FResList[i]);
 180         FResList.Clear;
 181         FTitle := '';
 182         Caption := '';
 183 end;
 184
 185 function TResPopup.ResCount: Integer;
 186 begin
 187         Result := FResList.Count;
 188 end;
 189
 190 end.