Changeset 6 for trunk/Messg.pas


Ignore:
Timestamp:
Jan 7, 2017, 11:32:14 AM (7 years ago)
Author:
chronos
Message:
  • Modified: Formated all project source files using Delphi formatter as original indentation and other formatting was really bad.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/Messg.pas

    r2 r6  
    11{$INCLUDE switches}
    2 
    32unit Messg;
    43
    … …  
    87  ScreenTools,
    98
    10   Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ButtonBase,ButtonA,
    11   ButtonB,Area;
     9  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonBase,
     10  ButtonA,
     11  ButtonB, Area;
    1212
    1313const
    14 WM_PLAYSOUND=WM_USER;
     14  WM_PLAYSOUND = WM_USER;
    1515
    1616type
    … …  
    2020    procedure SmartInvalidate; virtual;
    2121  protected
    22     TitleHeight: integer; // defines area to grip the window for moving (from top)
     22    TitleHeight: integer;
     23    // defines area to grip the window for moving (from top)
    2324    procedure InitButtons();
    24     procedure OnEraseBkgnd(var m:TMessage); message WM_ERASEBKGND;
    25     procedure OnHitTest(var Msg:TMessage); message WM_NCHITTEST;
     25    procedure OnEraseBkgnd(var m: TMessage); message WM_ERASEBKGND;
     26    procedure OnHitTest(var Msg: TMessage); message WM_NCHITTEST;
    2627  end;
    2728
    2829  TBaseMessgDlg = class(TDrawDlg)
    2930    procedure FormCreate(Sender: TObject);
    30     procedure FormPaint(Sender:TObject);
     31    procedure FormPaint(Sender: TObject);
    3132  public
    3233    MessgText: string;
    … …  
    4041    Button1: TButtonA;
    4142    Button2: TButtonA;
    42     procedure FormCreate(Sender:TObject);
    43     procedure FormPaint(Sender:TObject);
     43    procedure FormCreate(Sender: TObject);
     44    procedure FormPaint(Sender: TObject);
    4445    procedure FormShow(Sender: TObject);
    4546    procedure Button1Click(Sender: TObject);
    … …  
    5051    OpenSound: string;
    5152  private
    52     procedure OnPlaySound(var Msg:TMessage); message WM_PLAYSOUND;
     53    procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND;
    5354  end;
    5455
    5556const
    56 // message kinds
    57 mkOK=1; mkOKCancel=2; mkYesNo=3;
    58 
    59 Border=3;
    60 MessageLineSpacing=20;
    61 
    62 var
    63   MessgDlg:TMessgDlg;
     57  // message kinds
     58  mkOK = 1;
     59  mkOKCancel = 2;
     60  mkYesNo = 3;
     61
     62  Border = 3;
     63  MessageLineSpacing = 20;
     64
     65var
     66  MessgDlg: TMessgDlg;
    6467
    6568procedure SimpleMessage(SimpleText: string);
    6669procedure SoundMessage(SimpleText, SoundItem: string);
    6770
    68 
    6971implementation
    7072
    … …  
    7375constructor TDrawDlg.Create(AOwner: TComponent);
    7476begin
    75 inherited;
    76 TitleHeight:=0;
    77 end;
    78 
    79 procedure TDrawDlg.OnEraseBkgnd(var m:TMessage);
    80 begin
    81 end;
    82 
    83 procedure TDrawDlg.OnHitTest(var Msg:TMessage);
    84 var
    85 i: integer;
    86 ControlBounds: TRect;
    87 begin
    88 if BorderStyle<>bsNone then
    89   inherited
    90 else
    91   begin
    92   if integer(Msg.LParamHi)>=Top+TitleHeight then
    93     Msg.result:=HTCLIENT
     77  inherited;
     78  TitleHeight := 0;
     79end;
     80
     81procedure TDrawDlg.OnEraseBkgnd(var m: TMessage);
     82begin
     83end;
     84
     85procedure TDrawDlg.OnHitTest(var Msg: TMessage);
     86var
     87  i: integer;
     88  ControlBounds: TRect;
     89begin
     90  if BorderStyle <> bsNone then
     91    inherited
    9492  else
    95     begin
    96     for i:=0 to ControlCount-1 do if Controls[i].Visible then
    97       begin
    98       ControlBounds:=Controls[i].BoundsRect;
    99       if (integer(Msg.LParamLo)>=Left+ControlBounds.Left)
    100         and (integer(Msg.LParamLo)<Left+ControlBounds.Right)
    101         and (integer(Msg.LParamHi)>=Top+ControlBounds.Top)
    102         and (integer(Msg.LParamHi)<Top+ControlBounds.Bottom) then
     93  begin
     94    if integer(Msg.LParamHi) >= Top + TitleHeight then
     95      Msg.result := HTCLIENT
     96    else
     97    begin
     98      for i := 0 to ControlCount - 1 do
     99        if Controls[i].Visible then
    103100        begin
    104         Msg.result:=HTCLIENT;
    105         exit;
     101          ControlBounds := Controls[i].BoundsRect;
     102          if (integer(Msg.LParamLo) >= Left + ControlBounds.Left) and
     103            (integer(Msg.LParamLo) < Left + ControlBounds.Right) and
     104            (integer(Msg.LParamHi) >= Top + ControlBounds.Top) and
     105            (integer(Msg.LParamHi) < Top + ControlBounds.Bottom) then
     106          begin
     107            Msg.result := HTCLIENT;
     108            exit;
     109          end;
    106110        end;
    107       end;
    108     Msg.result:=HTCAPTION
     111      Msg.result := HTCAPTION
    109112    end;
    110113  end
    … …  
    113116procedure TDrawDlg.InitButtons();
    114117var
    115 cix: integer;
    116 //ButtonDownSound, ButtonUpSound: string;
    117 begin
    118 //ButtonDownSound:=Sounds.Lookup('BUTTON_DOWN');
    119 //ButtonUpSound:=Sounds.Lookup('BUTTON_UP');
    120 for cix:=0 to ComponentCount-1 do
    121   if Components[cix] is TButtonBase then
    122     begin
    123     TButtonBase(Components[cix]).Graphic:=GrExt[HGrSystem].Data;
    124 //      if ButtonDownSound<>'*' then
    125 //        DownSound:=HomeDir+'Sounds\'+ButtonDownSound+'.wav';
    126 //      if ButtonUpSound<>'*' then
    127 //        UpSound:=HomeDir+'Sounds\'+ButtonUpSound+'.wav';
    128     if Components[cix] is TButtonA then
    129       TButtonA(Components[cix]).Font:=UniFont[ftButton];
    130     if Components[cix] is TButtonB then
    131       TButtonB(Components[cix]).Mask:=GrExt[HGrSystem].Mask;
     118  cix: integer;
     119  // ButtonDownSound, ButtonUpSound: string;
     120begin
     121  // ButtonDownSound:=Sounds.Lookup('BUTTON_DOWN');
     122  // ButtonUpSound:=Sounds.Lookup('BUTTON_UP');
     123  for cix := 0 to ComponentCount - 1 do
     124    if Components[cix] is TButtonBase then
     125    begin
     126      TButtonBase(Components[cix]).Graphic := GrExt[HGrSystem].Data;
     127      // if ButtonDownSound<>'*' then
     128      // DownSound:=HomeDir+'Sounds\'+ButtonDownSound+'.wav';
     129      // if ButtonUpSound<>'*' then
     130      // UpSound:=HomeDir+'Sounds\'+ButtonUpSound+'.wav';
     131      if Components[cix] is TButtonA then
     132        TButtonA(Components[cix]).Font := UniFont[ftButton];
     133      if Components[cix] is TButtonB then
     134        TButtonB(Components[cix]).Mask := GrExt[HGrSystem].Mask;
    132135    end;
    133136end;
    … …  
    135138procedure TDrawDlg.SmartInvalidate;
    136139var
    137 i: integer;
    138 r0,r1: HRgn;
    139 begin
    140 r0:=CreateRectRgn(0,0,ClientWidth,ClientHeight);
    141 for i:=0 to ControlCount-1 do
    142   if not (Controls[i] is TArea) and Controls[i].Visible then
    143     begin
    144     with Controls[i].BoundsRect do
    145       r1:=CreateRectRgn(Left,Top,Right,Bottom);
    146     CombineRgn(r0,r0,r1,RGN_DIFF);
    147     DeleteObject(r1);
    148     end;
    149 InvalidateRgn(Handle,r0,false);
    150 DeleteObject(r0);
     140  i: integer;
     141  r0, r1: HRgn;
     142begin
     143  r0 := CreateRectRgn(0, 0, ClientWidth, ClientHeight);
     144  for i := 0 to ControlCount - 1 do
     145    if not(Controls[i] is TArea) and Controls[i].Visible then
     146    begin
     147      with Controls[i].BoundsRect do
     148        r1 := CreateRectRgn(Left, Top, Right, Bottom);
     149      CombineRgn(r0, r0, r1, RGN_DIFF);
     150      DeleteObject(r1);
     151    end;
     152  InvalidateRgn(Handle, r0, false);
     153  DeleteObject(r0);
    151154end;
    152155
    153156procedure TBaseMessgDlg.FormCreate(Sender: TObject);
    154157begin
    155 Left:=(Screen.Width-ClientWidth) div 2;
    156 Canvas.Font.Assign(UniFont[ftNormal]);
    157 Canvas.Brush.Style:=bsClear;
    158 MessgText:='';
    159 TopSpace:=0;
    160 TitleHeight:=Screen.Height;
    161 InitButtons();
    162 end;
    163 
    164 procedure TBaseMessgDlg.FormPaint(Sender:TObject);
    165 var
    166 i,cix: integer;
    167 begin
    168 PaintBackground(self,3+Border,3+Border,ClientWidth-(6+2*Border),
    169   ClientHeight-(6+2*Border));
    170 for i:=0 to Border do
    171   Frame(Canvas,i,i,ClientWidth-1-i,ClientHeight-1-i,
    172     $000000,$000000);
    173 Frame(Canvas,Border+1,Border+1,ClientWidth-(2+Border),ClientHeight-(2+Border),
    174   MainTexture.clBevelLight,MainTexture.clBevelShade);
    175 Frame(Canvas,2+Border,2+Border,ClientWidth-(3+Border),ClientHeight-(3+Border),
    176   MainTexture.clBevelLight,MainTexture.clBevelShade);
    177 SplitText(false);
    178 
    179 for cix:=0 to ControlCount-1 do
    180   if (Controls[cix].Visible) and (Controls[cix] is TButtonBase) then
    181     BtnFrame(Canvas,Controls[cix].BoundsRect,MainTexture);
     158  Left := (Screen.Width - ClientWidth) div 2;
     159  Canvas.Font.Assign(UniFont[ftNormal]);
     160  Canvas.Brush.Style := bsClear;
     161  MessgText := '';
     162  TopSpace := 0;
     163  TitleHeight := Screen.Height;
     164  InitButtons();
     165end;
     166
     167procedure TBaseMessgDlg.FormPaint(Sender: TObject);
     168var
     169  i, cix: integer;
     170begin
     171  PaintBackground(self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border),
     172    ClientHeight - (6 + 2 * Border));
     173  for i := 0 to Border do
     174    Frame(Canvas, i, i, ClientWidth - 1 - i, ClientHeight - 1 - i,
     175      $000000, $000000);
     176  Frame(Canvas, Border + 1, Border + 1, ClientWidth - (2 + Border),
     177    ClientHeight - (2 + Border), MainTexture.clBevelLight,
     178    MainTexture.clBevelShade);
     179  Frame(Canvas, 2 + Border, 2 + Border, ClientWidth - (3 + Border),
     180    ClientHeight - (3 + Border), MainTexture.clBevelLight,
     181    MainTexture.clBevelShade);
     182  SplitText(false);
     183
     184  for cix := 0 to ControlCount - 1 do
     185    if (Controls[cix].Visible) and (Controls[cix] is TButtonBase) then
     186      BtnFrame(Canvas, Controls[cix].BoundsRect, MainTexture);
    182187end;
    183188
    184189procedure TBaseMessgDlg.SplitText(preview: boolean);
    185190var
    186 Start,Stop,OrdinaryStop,LinesCount: integer;
    187 s: string;
    188 begin
    189 Start:=1;
    190 LinesCount:=0;
    191 while Start<Length(MessgText) do
    192   begin
    193   Stop:=Start;
    194   while(Stop<Length(MessgText)) and (MessgText[Stop]<>'\')
    195     and (BiColorTextWidth(Canvas,Copy(MessgText,Start,Stop-Start+1))
    196       <ClientWidth-56) do
    197     inc(Stop);
    198   if Stop<>Length(MessgText) then
    199     begin
    200     OrdinaryStop:=Stop;
    201     repeat dec(OrdinaryStop)
    202     until (MessgText[OrdinaryStop+1]=' ') or (MessgText[OrdinaryStop+1]='\');
    203     if (OrdinaryStop+1-Start)*2>=Stop-Start then
    204       Stop:=OrdinaryStop
    205     end;
    206   if not preview then
    207     begin
    208     s:=Copy(MessgText,Start,Stop-Start+1);
    209     LoweredTextOut(Canvas,-1,MainTexture,
    210       (ClientWidth-BiColorTextWidth(Canvas,s)) div 2,19+Border+TopSpace+LinesCount*MessageLineSpacing,s);
    211     end;
    212   Start:=Stop+2;
    213   inc(LinesCount)
    214   end;
    215 if preview then Lines:=LinesCount;
     191  Start, Stop, OrdinaryStop, LinesCount: integer;
     192  s: string;
     193begin
     194  Start := 1;
     195  LinesCount := 0;
     196  while Start < Length(MessgText) do
     197  begin
     198    Stop := Start;
     199    while (Stop < Length(MessgText)) and (MessgText[Stop] <> '\') and
     200      (BiColorTextWidth(Canvas, Copy(MessgText, Start, Stop - Start + 1)) <
     201      ClientWidth - 56) do
     202      inc(Stop);
     203    if Stop <> Length(MessgText) then
     204    begin
     205      OrdinaryStop := Stop;
     206      repeat
     207        dec(OrdinaryStop)
     208      until (MessgText[OrdinaryStop + 1] = ' ') or
     209        (MessgText[OrdinaryStop + 1] = '\');
     210      if (OrdinaryStop + 1 - Start) * 2 >= Stop - Start then
     211        Stop := OrdinaryStop
     212    end;
     213    if not preview then
     214    begin
     215      s := Copy(MessgText, Start, Stop - Start + 1);
     216      LoweredTextOut(Canvas, -1, MainTexture,
     217        (ClientWidth - BiColorTextWidth(Canvas, s)) div 2,
     218        19 + Border + TopSpace + LinesCount * MessageLineSpacing, s);
     219    end;
     220    Start := Stop + 2;
     221    inc(LinesCount)
     222  end;
     223  if preview then
     224    Lines := LinesCount;
    216225end;
    217226
    218227procedure TBaseMessgDlg.CorrectHeight;
    219228var
    220 i: integer;
    221 begin
    222 ClientHeight:=72+Border+TopSpace+Lines*MessageLineSpacing;
    223 Top:=(Screen.Height-ClientHeight) div 2;
    224 for i:=0 to ControlCount-1 do
    225   Controls[i].Top:=ClientHeight-(34+Border);
    226 end;
    227 
    228 procedure TMessgDlg.FormCreate(Sender:TObject);
    229 begin
    230 inherited;
    231 OpenSound:='';
     229  i: integer;
     230begin
     231  ClientHeight := 72 + Border + TopSpace + Lines * MessageLineSpacing;
     232  Top := (Screen.Height - ClientHeight) div 2;
     233  for i := 0 to ControlCount - 1 do
     234    Controls[i].Top := ClientHeight - (34 + Border);
     235end;
     236
     237procedure TMessgDlg.FormCreate(Sender: TObject);
     238begin
     239  inherited;
     240  OpenSound := '';
    232241end;
    233242
    234243procedure TMessgDlg.FormShow(Sender: TObject);
    235244begin
    236 Button1.Visible:=true;
    237 Button2.Visible:= not (Kind in [mkOK]);
    238 if Button2.Visible then Button1.Left:=101
    239 else Button1.Left:=159;
    240 if Kind=mkYesNo then
    241   begin
    242   Button1.Caption:=Phrases.Lookup('BTN_YES');
    243   Button2.Caption:=Phrases.Lookup('BTN_NO')
     245  Button1.Visible := true;
     246  Button2.Visible := not(Kind in [mkOK]);
     247  if Button2.Visible then
     248    Button1.Left := 101
     249  else
     250    Button1.Left := 159;
     251  if Kind = mkYesNo then
     252  begin
     253    Button1.Caption := Phrases.Lookup('BTN_YES');
     254    Button2.Caption := Phrases.Lookup('BTN_NO')
    244255  end
    245 else
    246   begin
    247   Button1.Caption:=Phrases.Lookup('BTN_OK');
    248   Button2.Caption:=Phrases.Lookup('BTN_CANCEL');
    249   end;
    250 
    251 SplitText(true);
    252 CorrectHeight;
    253 end;
    254 
    255 procedure TMessgDlg.FormPaint(Sender:TObject);
    256 begin
    257 inherited;
    258 if OpenSound<>'' then PostMessage(Handle, WM_PLAYSOUND, 0, 0);
    259 end; {FormPaint}
     256  else
     257  begin
     258    Button1.Caption := Phrases.Lookup('BTN_OK');
     259    Button2.Caption := Phrases.Lookup('BTN_CANCEL');
     260  end;
     261
     262  SplitText(true);
     263  CorrectHeight;
     264end;
     265
     266procedure TMessgDlg.FormPaint(Sender: TObject);
     267begin
     268  inherited;
     269  if OpenSound <> '' then
     270    PostMessage(Handle, WM_PLAYSOUND, 0, 0);
     271end; { FormPaint }
    260272
    261273procedure TMessgDlg.Button1Click(Sender: TObject);
    262274begin
    263 ModalResult:=mrOK;
     275  ModalResult := mrOK;
    264276end;
    265277
    266278procedure TMessgDlg.Button2Click(Sender: TObject);
    267279begin
    268 ModalResult:=mrIgnore;
     280  ModalResult := mrIgnore;
    269281end;
    270282
    271283procedure TMessgDlg.FormKeyPress(Sender: TObject; var Key: char);
    272284begin
    273 if Key=#13 then ModalResult:=mrOK
    274 //else if (Key=#27) and (Button2.Visible) then ModalResult:=mrCancel
     285  if Key = #13 then
     286    ModalResult := mrOK
     287    // else if (Key=#27) and (Button2.Visible) then ModalResult:=mrCancel
    275288end;
    276289
    277290procedure SimpleMessage(SimpleText: string);
    278291begin
    279 with MessgDlg do
    280   begin
    281   MessgText:=SimpleText;
    282   Kind:=mkOK;
    283   ShowModal;
     292  with MessgDlg do
     293  begin
     294    MessgText := SimpleText;
     295    Kind := mkOK;
     296    ShowModal;
    284297  end
    285298end;
    … …  
    287300procedure SoundMessage(SimpleText, SoundItem: string);
    288301begin
    289 with MessgDlg do
    290   begin
    291   MessgText:=SimpleText;
    292   OpenSound:=SoundItem;
    293   Kind:=mkOK;
    294   ShowModal;
     302  with MessgDlg do
     303  begin
     304    MessgText := SimpleText;
     305    OpenSound := SoundItem;
     306    Kind := mkOK;
     307    ShowModal;
    295308  end
    296309end;
    297310
    298 procedure TMessgDlg.OnPlaySound(var Msg:TMessage);
    299 begin
    300 Play(OpenSound);
    301 OpenSound:='';
     311procedure TMessgDlg.OnPlaySound(var Msg: TMessage);
     312begin
     313  Play(OpenSound);
     314  OpenSound := '';
    302315end;
    303316
    304317end.
    305 
Note: See TracChangeset for help on using the changeset viewer.