Ignore:
Timestamp:
Jan 7, 2017, 11:32:14 AM (8 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/LocalPlayer/BaseWin.pas

    r2 r6  
    11{$INCLUDE switches}
    2 
    32unit BaseWin;
    43
    … …  
    65
    76uses
    8   ScreenTools,Messg,
    9 
    10   Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms;
     7  ScreenTools, Messg,
     8
     9  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;
    1110
    1211type
    … …  
    1615    constructor Create(AOwner: TComponent); override;
    1716    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    18     procedure FormPaint(Sender:TObject);
    19     procedure FormKeyDown(Sender: TObject; var Key: Word;
    20       Shift: TShiftState);
     17    procedure FormPaint(Sender: TObject);
     18    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    2119    procedure FormDeactivate(Sender: TObject);
    2220    procedure SmartUpdateContent(ImmUpdate: boolean = false);
    2321    procedure StayOnTop_Workaround;
    2422  protected
    25     FWindowMode,ModalFrameIndent: integer;
     23    FWindowMode, ModalFrameIndent: integer;
    2624    HelpContext: string;
    2725    procedure ShowNewContent(NewMode: integer; forceclose: boolean = false);
    28     procedure MarkUsedOffscreen(xMax,yMax: integer);
     26    procedure MarkUsedOffscreen(xMax, yMax: integer);
    2927    procedure OffscreenPaint; virtual;
    3028    procedure VPaint; virtual;
    … …  
    3331  end;
    3432
    35 
    3633  TFramedDlg = class(TBufferedDrawDlg)
    3734  public
    3835    constructor Create(AOwner: TComponent); override;
    39     procedure FormCreate(Sender:TObject);
     36    procedure FormCreate(Sender: TObject);
    4037    procedure SmartInvalidate; override;
    4138  protected
    … …  
    4441    procedure InitWindowRegion;
    4542    procedure VPaint; override;
    46     procedure FillOffscreen(Left,Top,Width,Height: integer);
    47     end;
    48 
     43    procedure FillOffscreen(Left, Top, Width, Height: integer);
     44  end;
    4945
    5046const
    51 // window modes
    52 wmNone=0; wmModal=$1; wmPersistent=$2; wmSubmodal=$3;
    53 
    54 
    55 yUnused=161;
    56 NarrowFrame=11; WideFrame=36; SideFrame=9;
     47  // window modes
     48  wmNone = 0;
     49  wmModal = $1;
     50  wmPersistent = $2;
     51  wmSubmodal = $3;
     52
     53  yUnused = 161;
     54  NarrowFrame = 11;
     55  WideFrame = 36;
     56  SideFrame = 9;
    5757
    5858var
    59 UsedOffscreenWidth, UsedOffscreenHeight: integer;
    60 Offscreen: TBitmap;
    61 OffscreenUser: TForm;
     59  UsedOffscreenWidth, UsedOffscreenHeight: integer;
     60  Offscreen: TBitmap;
     61  OffscreenUser: TForm;
    6262
    6363procedure CreateOffscreen;
    6464
    65 
    6665implementation
    6766
    6867uses
    69 Term, Help, ButtonBase, Area;
    70 
     68  Term, Help, ButtonBase, Area;
    7169
    7270constructor TBufferedDrawDlg.Create;
    7371begin
    74 OnClose:=FormClose;
    75 OnPaint:=FormPaint;
    76 OnKeyDown:=FormKeyDown;
    77 OnDeactivate:=FormDeactivate;
    78 inherited;
    79 FWindowMode:=wmNone;
    80 HelpContext:='CONCEPTS';
    81 TitleHeight:=WideFrame;
    82 ModalFrameIndent:=45;
    83 UserLeft:=(Screen.Width-Width) div 2;
    84 UserTop:=(Screen.Height-Height) div 2;
     72  OnClose := FormClose;
     73  OnPaint := FormPaint;
     74  OnKeyDown := FormKeyDown;
     75  OnDeactivate := FormDeactivate;
     76  inherited;
     77  FWindowMode := wmNone;
     78  HelpContext := 'CONCEPTS';
     79  TitleHeight := WideFrame;
     80  ModalFrameIndent := 45;
     81  UserLeft := (Screen.Width - Width) div 2;
     82  UserTop := (Screen.Height - Height) div 2;
    8583end;
    8684
    8785procedure TBufferedDrawDlg.FormClose(Sender: TObject; var Action: TCloseAction);
    8886begin
    89 if FWindowMode=wmPersistent then
    90   begin UserLeft:=Left; UserTop:=Top end;
    91 if OffscreenUser=self then OffscreenUser:=nil;
    92 end;
    93 
    94 procedure TBufferedDrawDlg.FormPaint(Sender:TObject);
    95 begin
    96 if OffscreenUser<>self then OffscreenPaint;
    97 VPaint
     87  if FWindowMode = wmPersistent then
     88  begin
     89    UserLeft := Left;
     90    UserTop := Top
     91  end;
     92  if OffscreenUser = self then
     93    OffscreenUser := nil;
     94end;
     95
     96procedure TBufferedDrawDlg.FormPaint(Sender: TObject);
     97begin
     98  if OffscreenUser <> self then
     99    OffscreenPaint;
     100  VPaint
    98101end;
    99102
    … …  
    101104  Shift: TShiftState);
    102105begin
    103 if Key=VK_ESCAPE then
    104   begin
    105   if fsModal in FormState then ModalResult:=mrCancel
    106   end
    107 else if Key=VK_RETURN then
    108   begin
    109   if fsModal in FormState then ModalResult:=mrOK
    110   end
    111 else if Key=VK_F1 then
    112   HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, HelpDlg.TextIndex(HelpContext))
    113 else if FWindowMode=wmPersistent then
    114   MainScreen.FormKeyDown(Sender, Key, Shift);
     106  if Key = VK_ESCAPE then
     107  begin
     108    if fsModal in FormState then
     109      ModalResult := mrCancel
     110  end
     111  else if Key = VK_RETURN then
     112  begin
     113    if fsModal in FormState then
     114      ModalResult := mrOK
     115  end
     116  else if Key = VK_F1 then
     117    HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText,
     118      HelpDlg.TextIndex(HelpContext))
     119  else if FWindowMode = wmPersistent then
     120    MainScreen.FormKeyDown(Sender, Key, Shift);
    115121end;
    116122
    117123procedure TBufferedDrawDlg.FormDeactivate(Sender: TObject);
    118124begin
    119 if FWindowMode=wmSubmodal then Close
     125  if FWindowMode = wmSubmodal then
     126    Close
    120127end;
    121128
    122129procedure TBufferedDrawDlg.OffscreenPaint;
    123130begin
    124 if (OffscreenUser<>nil) and (OffscreenUser<>self) then
    125   OffscreenUser.Update; // complete working with old owner to prevent rebound
    126 OffscreenUser:=self;
     131  if (OffscreenUser <> nil) and (OffscreenUser <> self) then
     132    OffscreenUser.Update; // complete working with old owner to prevent rebound
     133  OffscreenUser := self;
    127134end;
    128135
    129136procedure TBufferedDrawDlg.VPaint;
    130137begin
    131 BitBlt(Canvas.Handle, 0, 0, ClientWidth,
    132   ClientHeight, offscreen.Canvas. Handle, 0, 0, SRCCOPY);
    133 end;
    134 
    135 procedure TBufferedDrawDlg.ShowNewContent(NewMode: integer; forceclose: boolean);
    136 begin
    137 if Visible then
    138   begin
    139   assert((NewMode=wmModal) or (FWindowMode<>wmModal)); // don't make modal window non-modal
    140   if (NewMode=wmModal) and (forceclose or (FWindowMode<>wmModal)) then
     138  BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
     139    Offscreen.Canvas.Handle, 0, 0, SRCCOPY);
     140end;
     141
     142procedure TBufferedDrawDlg.ShowNewContent(NewMode: integer;
     143  forceclose: boolean);
     144begin
     145  if Visible then
     146  begin
     147    assert((NewMode = wmModal) or (FWindowMode <> wmModal));
     148    // don't make modal window non-modal
     149    if (NewMode = wmModal) and (forceclose or (FWindowMode <> wmModal)) then
    141150    begin // make modal
    142     UserLeft:=Left;
    143     UserTop:=Top;
    144     Visible:=false;
    145     FWindowMode:=NewMode;
    146     ShowModal;
     151      UserLeft := Left;
     152      UserTop := Top;
     153      Visible := false;
     154      FWindowMode := NewMode;
     155      ShowModal;
    147156    end
    148   else if forceclose then
     157    else if forceclose then
    149158    begin // make modal
    150     Visible:=false;
    151     FWindowMode:=NewMode;
    152     Left:=UserLeft;
    153     Top:=UserTop;
    154     Show;
     159      Visible := false;
     160      FWindowMode := NewMode;
     161      Left := UserLeft;
     162      Top := UserTop;
     163      Show;
    155164    end
    156   else
    157     begin
    158     FWindowMode:=NewMode;
    159     if @OnShow<>nil then
    160       OnShow(nil);
    161     Invalidate;
    162     BringToFront
     165    else
     166    begin
     167      FWindowMode := NewMode;
     168      if @OnShow <> nil then
     169        OnShow(nil);
     170      Invalidate;
     171      BringToFront
    163172    end
    164173  end
    165 else
    166   begin
    167   FWindowMode:=NewMode;
    168   Left:=UserLeft;
    169   Top:=UserTop;
    170   if FWindowMode=wmModal then ShowModal
    171   else Show
     174  else
     175  begin
     176    FWindowMode := NewMode;
     177    Left := UserLeft;
     178    Top := UserTop;
     179    if FWindowMode = wmModal then
     180      ShowModal
     181    else
     182      Show
    172183  end
    173184end;
    … …  
    175186procedure TBufferedDrawDlg.SmartUpdateContent(ImmUpdate: boolean);
    176187begin
    177 if Visible then
    178   begin
    179   OffscreenPaint;
    180   SmartInvalidate;
    181   if ImmUpdate then Update
    182   end
    183 end;
    184 
    185 procedure TBufferedDrawDlg.MarkUsedOffscreen(xMax,yMax: integer);
    186 begin
    187 if xMax>UsedOffscreenWidth then UsedOffscreenWidth:=xMax;
    188 if yMax>UsedOffscreenHeight then UsedOffscreenHeight:=yMax;
     188  if Visible then
     189  begin
     190    OffscreenPaint;
     191    SmartInvalidate;
     192    if ImmUpdate then
     193      Update
     194  end
     195end;
     196
     197procedure TBufferedDrawDlg.MarkUsedOffscreen(xMax, yMax: integer);
     198begin
     199  if xMax > UsedOffscreenWidth then
     200    UsedOffscreenWidth := xMax;
     201  if yMax > UsedOffscreenHeight then
     202    UsedOffscreenHeight := yMax;
    189203end;
    190204
    … …  
    193207// after application lost focus, so show all stayontop-windows in first turn
    194208var
    195 SaveOnShow, SaveOnPaint: TNotifyEvent;
    196 begin
    197 Top:=Screen.Height;
    198 SaveOnShow:=OnShow;
    199 OnShow:=nil;
    200 SaveOnPaint:=OnPaint;
    201 OnPaint:=nil;
    202 FWindowMode:=wmNone;
    203 Show;
    204 Hide;
    205 OnShow:=SaveOnShow;
    206 OnPaint:=SaveOnPaint;
    207 end;
    208 
     209  SaveOnShow, SaveOnPaint: TNotifyEvent;
     210begin
     211  Top := Screen.Height;
     212  SaveOnShow := OnShow;
     213  OnShow := nil;
     214  SaveOnPaint := OnPaint;
     215  OnPaint := nil;
     216  FWindowMode := wmNone;
     217  Show;
     218  Hide;
     219  OnShow := SaveOnShow;
     220  OnPaint := SaveOnPaint;
     221end;
    209222
    210223constructor TFramedDlg.Create;
    211224begin
    212 OnCreate:=FormCreate;
    213 inherited;
    214 end;
    215 
    216 procedure TFramedDlg.FormCreate(Sender:TObject);
    217 begin
    218 CaptionLeft:=0; CaptionRight:=$FFFF;
    219 WideBottom:=false;
    220 FullCaption:=true;
    221 TexOverride:=false;
    222 ModalIndication:=true;
    223 Canvas.Brush.Style:=bsClear;
    224 InnerWidth:=ClientWidth-2*SideFrame;
    225 InnerHeight:=ClientHeight-TitleHeight-NarrowFrame;
     225  OnCreate := FormCreate;
     226  inherited;
     227end;
     228
     229procedure TFramedDlg.FormCreate(Sender: TObject);
     230begin
     231  CaptionLeft := 0;
     232  CaptionRight := $FFFF;
     233  WideBottom := false;
     234  FullCaption := true;
     235  TexOverride := false;
     236  ModalIndication := true;
     237  Canvas.Brush.Style := bsClear;
     238  InnerWidth := ClientWidth - 2 * SideFrame;
     239  InnerHeight := ClientHeight - TitleHeight - NarrowFrame;
    226240end;
    227241
    228242procedure TFramedDlg.SmartInvalidate;
    229243var
    230 i,BottomFrame: integer;
    231 r0,r1: HRgn;
    232 begin
    233 if WideBottom then BottomFrame:=WideFrame else BottomFrame:=NarrowFrame;
    234 r0:=CreateRectRgn(SideFrame,TitleHeight,ClientWidth-SideFrame,
    235   ClientHeight-BottomFrame);
    236 for i:=0 to ControlCount-1 do
    237   if not (Controls[i] is TArea) and Controls[i].Visible then
    238     begin
    239     with Controls[i].BoundsRect do
    240       r1:=CreateRectRgn(Left,Top,Right,Bottom);
    241     CombineRgn(r0,r0,r1,RGN_DIFF);
    242     DeleteObject(r1);
     244  i, BottomFrame: integer;
     245  r0, r1: HRgn;
     246begin
     247  if WideBottom then
     248    BottomFrame := WideFrame
     249  else
     250    BottomFrame := NarrowFrame;
     251  r0 := CreateRectRgn(SideFrame, TitleHeight, ClientWidth - SideFrame,
     252    ClientHeight - BottomFrame);
     253  for i := 0 to ControlCount - 1 do
     254    if not(Controls[i] is TArea) and Controls[i].Visible then
     255    begin
     256      with Controls[i].BoundsRect do
     257        r1 := CreateRectRgn(Left, Top, Right, Bottom);
     258      CombineRgn(r0, r0, r1, RGN_DIFF);
     259      DeleteObject(r1);
    243260    end;
    244 InvalidateRgn(Handle,r0,false);
    245 DeleteObject(r0);
     261  InvalidateRgn(Handle, r0, false);
     262  DeleteObject(r0);
    246263end;
    247264
    248265procedure TFramedDlg.VPaint;
    249266
    250   procedure CornerFrame(x0,y0,x1,y1: integer);
    251   begin
    252   Frame(Canvas,x0+1,y0+1,x1-2,y1-2,MainTexture.clBevelLight,MainTexture.clBevelShade);
    253   Frame(Canvas,x0+2,y0+2,x1-3,y1-3,MainTexture.clBevelLight,MainTexture.clBevelShade);
    254   Corner(Canvas,x0+1,y0+1,0,MainTexture);
    255   Corner(Canvas,x1-9,y0+1,1,MainTexture);
    256   Corner(Canvas,x0+1,y1-9,2,MainTexture);
    257   Corner(Canvas,x1-9,y1-9,3,MainTexture);
     267  procedure CornerFrame(x0, y0, x1, y1: integer);
     268  begin
     269    Frame(Canvas, x0 + 1, y0 + 1, x1 - 2, y1 - 2, MainTexture.clBevelLight,
     270      MainTexture.clBevelShade);
     271    Frame(Canvas, x0 + 2, y0 + 2, x1 - 3, y1 - 3, MainTexture.clBevelLight,
     272      MainTexture.clBevelShade);
     273    Corner(Canvas, x0 + 1, y0 + 1, 0, MainTexture);
     274    Corner(Canvas, x1 - 9, y0 + 1, 1, MainTexture);
     275    Corner(Canvas, x0 + 1, y1 - 9, 2, MainTexture);
     276    Corner(Canvas, x1 - 9, y1 - 9, 3, MainTexture);
    258277  end;
    259278
    260279var
    261 i,l,FrameTop,FrameBottom,InnerBottom,Cut,xTexOffset,yTexOffset: integer;
    262 R: TRect;
    263 begin
    264 if not TexOverride then
    265   begin
    266   if (FWindowMode=wmModal) and ModalIndication then MainTexture:=MainTexture
    267   else MainTexture:=MainTexture;
    268   MainTexture:=MainTexture
    269   end;
    270 Canvas.Font.Assign(UniFont[ftCaption]);
    271 l:=BiColorTextWidth(Canvas,Caption);
    272 Cut:=(ClientWidth-l) div 2;
    273 xTexOffset:=(wMaintexture-ClientWidth) div 2;
    274 yTexOffset:=(hMaintexture-ClientHeight) div 2;
    275 if WideBottom then InnerBottom:=ClientHeight-WideFrame
    276 else InnerBottom:=ClientHeight-NarrowFrame;
    277 if FullCaption then begin FrameTop:=0; FrameBottom:=ClientHeight end
    278 else
    279   begin
    280   FrameTop:=TitleHeight-NarrowFrame;
    281   if WideBottom then FrameBottom:=ClientHeight-(WideFrame-NarrowFrame)
    282   else FrameBottom:=ClientHeight
    283   end;
    284 Fill(Canvas,3,InnerBottom+1,ClientWidth-6,ClientHeight-InnerBottom-4,
    285   xTexOffset,yTexOffset);
    286 Fill(Canvas,3,TitleHeight-2,SideFrame-3,InnerBottom-TitleHeight+4,
    287   xTexOffset,yTexOffset);
    288 Fill(Canvas,ClientWidth-SideFrame,TitleHeight-2,SideFrame-3,
    289   InnerBottom-TitleHeight+4,xTexOffset,yTexOffset);
    290 Frame(Canvas,0,FrameTop,ClientWidth-1,FrameBottom-1,0,0);
    291 Frame(Canvas,SideFrame-1,TitleHeight-1,ClientWidth-SideFrame,
    292   InnerBottom,MainTexture.clBevelShade,MainTexture.clBevelLight);
    293 //RFrame(Canvas,SideFrame-2,TitleHeight-2,ClientWidth-SideFrame+1,
    294 //  InnerBottom+1,MainTexture.clBevelShade,MainTexture.clBevelLight);
    295 if FullCaption then
    296   begin
    297   if (FWindowMode<>wmModal) or not ModalIndication then
    298     begin
    299     Fill(Canvas,3,3+FrameTop,ClientWidth-6,TitleHeight-FrameTop-4,
    300       xTexOffset,yTexOffset);
    301     CornerFrame(0,FrameTop,ClientWidth,FrameBottom);
     280  i, l, FrameTop, FrameBottom, InnerBottom, Cut, xTexOffset,
     281    yTexOffset: integer;
     282  R: TRect;
     283begin
     284  if not TexOverride then
     285  begin
     286    if (FWindowMode = wmModal) and ModalIndication then
     287      MainTexture := MainTexture
     288    else
     289      MainTexture := MainTexture;
     290    MainTexture := MainTexture
     291  end;
     292  Canvas.Font.Assign(UniFont[ftCaption]);
     293  l := BiColorTextWidth(Canvas, Caption);
     294  Cut := (ClientWidth - l) div 2;
     295  xTexOffset := (wMaintexture - ClientWidth) div 2;
     296  yTexOffset := (hMaintexture - ClientHeight) div 2;
     297  if WideBottom then
     298    InnerBottom := ClientHeight - WideFrame
     299  else
     300    InnerBottom := ClientHeight - NarrowFrame;
     301  if FullCaption then
     302  begin
     303    FrameTop := 0;
     304    FrameBottom := ClientHeight
     305  end
     306  else
     307  begin
     308    FrameTop := TitleHeight - NarrowFrame;
     309    if WideBottom then
     310      FrameBottom := ClientHeight - (WideFrame - NarrowFrame)
     311    else
     312      FrameBottom := ClientHeight
     313  end;
     314  Fill(Canvas, 3, InnerBottom + 1, ClientWidth - 6, ClientHeight - InnerBottom -
     315    4, xTexOffset, yTexOffset);
     316  Fill(Canvas, 3, TitleHeight - 2, SideFrame - 3, InnerBottom - TitleHeight + 4,
     317    xTexOffset, yTexOffset);
     318  Fill(Canvas, ClientWidth - SideFrame, TitleHeight - 2, SideFrame - 3,
     319    InnerBottom - TitleHeight + 4, xTexOffset, yTexOffset);
     320  Frame(Canvas, 0, FrameTop, ClientWidth - 1, FrameBottom - 1, 0, 0);
     321  Frame(Canvas, SideFrame - 1, TitleHeight - 1, ClientWidth - SideFrame,
     322    InnerBottom, MainTexture.clBevelShade, MainTexture.clBevelLight);
     323  // RFrame(Canvas,SideFrame-2,TitleHeight-2,ClientWidth-SideFrame+1,
     324  // InnerBottom+1,MainTexture.clBevelShade,MainTexture.clBevelLight);
     325  if FullCaption then
     326  begin
     327    if (FWindowMode <> wmModal) or not ModalIndication then
     328    begin
     329      Fill(Canvas, 3, 3 + FrameTop, ClientWidth - 6, TitleHeight - FrameTop - 4,
     330        xTexOffset, yTexOffset);
     331      CornerFrame(0, FrameTop, ClientWidth, FrameBottom);
    302332    end
    303   else with Canvas do
    304     begin
    305     Fill(Canvas,3+ModalFrameIndent,3+FrameTop,ClientWidth-6-2*ModalFrameIndent,
    306       TitleHeight-FrameTop-4,xTexOffset,yTexOffset);
    307     Fill(Canvas,ClientWidth-3-ModalFrameIndent,3+FrameTop,ModalFrameIndent,
    308       TitleHeight-FrameTop-4,xTexOffset,yTexOffset);
    309     Fill(Canvas,3,3+FrameTop,ModalFrameIndent,TitleHeight-FrameTop-4,
    310       xTexOffset,yTexOffset);
    311     CornerFrame(0,FrameTop,ClientWidth,FrameBottom);
    312     Pen.Color:=MainTexture.clBevelShade;
    313     MoveTo(3+ModalFrameIndent,2); LineTo(3+ModalFrameIndent,TitleHeight);
    314     Pen.Color:=MainTexture.clBevelShade;
    315     MoveTo(4+ModalFrameIndent,TitleHeight-1);
    316     LineTo(ClientWidth-4-ModalFrameIndent,TitleHeight-1);
    317     LineTo(ClientWidth-4-ModalFrameIndent,1);
    318     Pen.Color:=MainTexture.clBevelLight;
    319     MoveTo(ClientWidth-5-ModalFrameIndent,2);
    320     LineTo(4+ModalFrameIndent,2);
    321     LineTo(4+ModalFrameIndent,TitleHeight);
    322     MoveTo(ClientWidth-4-ModalFrameIndent,1);
    323     LineTo(3+ModalFrameIndent,1);
    324     Pen.Color:=MainTexture.clBevelLight;
    325     MoveTo(ClientWidth-3-ModalFrameIndent,3); LineTo(ClientWidth-3-ModalFrameIndent,TitleHeight);
    326     end
    327   end
    328 else
    329   begin
    330   Fill(Canvas,3,3+FrameTop,ClientWidth-6,TitleHeight-FrameTop-4,
    331     xTexOffset,yTexOffset);
    332   CornerFrame(0,FrameTop,ClientWidth,FrameBottom);
    333 
    334   Frame(Canvas,CaptionLeft,0,ClientWidth-CaptionLeft-1,FrameTop,0,0);
    335   Fill(Canvas,CaptionLeft+3,3,ClientWidth-2*(CaptionLeft)-6,TitleHeight-4,
    336     xTexOffset,yTexOffset);
    337 
    338   Frame(Canvas,CaptionLeft+1,0+1,
    339     ClientWidth-CaptionLeft-2,TitleHeight-1,MainTexture.clBevelLight,MainTexture.clBevelShade);
    340   Frame(Canvas,CaptionLeft+2,0+2,
    341     ClientWidth-CaptionLeft-3,TitleHeight-1,MainTexture.clBevelLight,MainTexture.clBevelShade);
    342   Corner(Canvas,CaptionLeft+1,0+1,0,MainTexture);
    343   Corner(Canvas,ClientWidth-CaptionLeft-9,0+1,1,MainTexture);
    344 
    345   with Canvas do
    346     begin
    347     Pen.Color:=MainTexture.clBevelShade;
    348     MoveTo(CaptionLeft+1,FrameTop+2);
    349     LineTo(CaptionLeft+1,TitleHeight);
    350     Pen.Color:=MainTexture.clBevelLight;
    351     MoveTo(ClientWidth-CaptionLeft-2,FrameTop+2);
    352     LineTo(ClientWidth-CaptionLeft-2,TitleHeight);
     333    else
     334      with Canvas do
     335      begin
     336        Fill(Canvas, 3 + ModalFrameIndent, 3 + FrameTop,
     337          ClientWidth - 6 - 2 * ModalFrameIndent, TitleHeight - FrameTop - 4,
     338          xTexOffset, yTexOffset);
     339        Fill(Canvas, ClientWidth - 3 - ModalFrameIndent, 3 + FrameTop,
     340          ModalFrameIndent, TitleHeight - FrameTop - 4, xTexOffset, yTexOffset);
     341        Fill(Canvas, 3, 3 + FrameTop, ModalFrameIndent, TitleHeight - FrameTop -
     342          4, xTexOffset, yTexOffset);
     343        CornerFrame(0, FrameTop, ClientWidth, FrameBottom);
     344        Pen.Color := MainTexture.clBevelShade;
     345        MoveTo(3 + ModalFrameIndent, 2);
     346        LineTo(3 + ModalFrameIndent, TitleHeight);
     347        Pen.Color := MainTexture.clBevelShade;
     348        MoveTo(4 + ModalFrameIndent, TitleHeight - 1);
     349        LineTo(ClientWidth - 4 - ModalFrameIndent, TitleHeight - 1);
     350        LineTo(ClientWidth - 4 - ModalFrameIndent, 1);
     351        Pen.Color := MainTexture.clBevelLight;
     352        MoveTo(ClientWidth - 5 - ModalFrameIndent, 2);
     353        LineTo(4 + ModalFrameIndent, 2);
     354        LineTo(4 + ModalFrameIndent, TitleHeight);
     355        MoveTo(ClientWidth - 4 - ModalFrameIndent, 1);
     356        LineTo(3 + ModalFrameIndent, 1);
     357        Pen.Color := MainTexture.clBevelLight;
     358        MoveTo(ClientWidth - 3 - ModalFrameIndent, 3);
     359        LineTo(ClientWidth - 3 - ModalFrameIndent, TitleHeight);
     360      end
     361  end
     362  else
     363  begin
     364    Fill(Canvas, 3, 3 + FrameTop, ClientWidth - 6, TitleHeight - FrameTop - 4,
     365      xTexOffset, yTexOffset);
     366    CornerFrame(0, FrameTop, ClientWidth, FrameBottom);
     367
     368    Frame(Canvas, CaptionLeft, 0, ClientWidth - CaptionLeft - 1,
     369      FrameTop, 0, 0);
     370    Fill(Canvas, CaptionLeft + 3, 3, ClientWidth - 2 * (CaptionLeft) - 6,
     371      TitleHeight - 4, xTexOffset, yTexOffset);
     372
     373    Frame(Canvas, CaptionLeft + 1, 0 + 1, ClientWidth - CaptionLeft - 2,
     374      TitleHeight - 1, MainTexture.clBevelLight, MainTexture.clBevelShade);
     375    Frame(Canvas, CaptionLeft + 2, 0 + 2, ClientWidth - CaptionLeft - 3,
     376      TitleHeight - 1, MainTexture.clBevelLight, MainTexture.clBevelShade);
     377    Corner(Canvas, CaptionLeft + 1, 0 + 1, 0, MainTexture);
     378    Corner(Canvas, ClientWidth - CaptionLeft - 9, 0 + 1, 1, MainTexture);
     379
     380    with Canvas do
     381    begin
     382      Pen.Color := MainTexture.clBevelShade;
     383      MoveTo(CaptionLeft + 1, FrameTop + 2);
     384      LineTo(CaptionLeft + 1, TitleHeight);
     385      Pen.Color := MainTexture.clBevelLight;
     386      MoveTo(ClientWidth - CaptionLeft - 2, FrameTop + 2);
     387      LineTo(ClientWidth - CaptionLeft - 2, TitleHeight);
    353388    end;
    354   if WideBottom then
    355     begin
    356     Frame(Canvas,CaptionLeft,FrameBottom,ClientWidth-CaptionLeft-1,ClientHeight-1,0,0);
    357     Fill(Canvas,CaptionLeft+3,ClientHeight-3-(WideFrame-5),
    358       ClientWidth-2*(CaptionLeft)-6,WideFrame-5,xTexOffset,yTexOffset);
    359     Frame(Canvas,CaptionLeft+1,ClientHeight-WideFrame-1+1,
    360       ClientWidth-CaptionLeft-2,ClientHeight-2,MainTexture.clBevelLight,MainTexture.clBevelShade);
    361     Frame(Canvas,CaptionLeft+2,ClientHeight-WideFrame-1+1,
    362       ClientWidth-CaptionLeft-3,ClientHeight-3,MainTexture.clBevelLight,MainTexture.clBevelShade);
    363     Corner(Canvas,CaptionLeft+1,ClientHeight-9,2,MainTexture);
    364     Corner(Canvas,ClientWidth-CaptionLeft-9,ClientHeight-9,3,MainTexture);
    365 
    366     with Canvas do
     389    if WideBottom then
     390    begin
     391      Frame(Canvas, CaptionLeft, FrameBottom, ClientWidth - CaptionLeft - 1,
     392        ClientHeight - 1, 0, 0);
     393      Fill(Canvas, CaptionLeft + 3, ClientHeight - 3 - (WideFrame - 5),
     394        ClientWidth - 2 * (CaptionLeft) - 6, WideFrame - 5, xTexOffset,
     395        yTexOffset);
     396      Frame(Canvas, CaptionLeft + 1, ClientHeight - WideFrame - 1 + 1,
     397        ClientWidth - CaptionLeft - 2, ClientHeight - 2,
     398        MainTexture.clBevelLight, MainTexture.clBevelShade);
     399      Frame(Canvas, CaptionLeft + 2, ClientHeight - WideFrame - 1 + 1,
     400        ClientWidth - CaptionLeft - 3, ClientHeight - 3,
     401        MainTexture.clBevelLight, MainTexture.clBevelShade);
     402      Corner(Canvas, CaptionLeft + 1, ClientHeight - 9, 2, MainTexture);
     403      Corner(Canvas, ClientWidth - CaptionLeft - 9, ClientHeight - 9, 3,
     404        MainTexture);
     405
     406      with Canvas do
    367407      begin
    368       Pen.Color:=MainTexture.clBevelShade;
    369       MoveTo(CaptionLeft+1,ClientHeight-WideFrame);
    370       LineTo(CaptionLeft+1,FrameBottom-2);
    371       Pen.Color:=MainTexture.clBevelLight;
    372       MoveTo(ClientWidth-CaptionLeft-2,ClientHeight-WideFrame);
    373       LineTo(ClientWidth-CaptionLeft-2,FrameBottom-2);
     408        Pen.Color := MainTexture.clBevelShade;
     409        MoveTo(CaptionLeft + 1, ClientHeight - WideFrame);
     410        LineTo(CaptionLeft + 1, FrameBottom - 2);
     411        Pen.Color := MainTexture.clBevelLight;
     412        MoveTo(ClientWidth - CaptionLeft - 2, ClientHeight - WideFrame);
     413        LineTo(ClientWidth - CaptionLeft - 2, FrameBottom - 2);
    374414      end;
    375415    end
    376416  end;
    377 RisedTextOut(Canvas,Cut-1,7,Caption);
    378 
    379 for i:=0 to ControlCount-1 do
    380   if Controls[i].Visible and (Controls[i] is TButtonBase) then
    381     begin
    382     R:=Controls[i].BoundsRect;
    383     if (R.Bottom<=TitleHeight) or (R.Top>=InnerBottom) then
    384       BtnFrame(Canvas,R,MainTexture);
     417  RisedTextOut(Canvas, Cut - 1, 7, Caption);
     418
     419  for i := 0 to ControlCount - 1 do
     420    if Controls[i].Visible and (Controls[i] is TButtonBase) then
     421    begin
     422      R := Controls[i].BoundsRect;
     423      if (R.Bottom <= TitleHeight) or (R.Top >= InnerBottom) then
     424        BtnFrame(Canvas, R, MainTexture);
    385425    end;
    386426
    387 BitBlt(Canvas.Handle,SideFrame,TitleHeight,ClientWidth-2*SideFrame,
    388   InnerBottom-TitleHeight,offscreen.Canvas.Handle,0,0,SRCCOPY);
     427  BitBlt(Canvas.Handle, SideFrame, TitleHeight, ClientWidth - 2 * SideFrame,
     428    InnerBottom - TitleHeight, Offscreen.Canvas.Handle, 0, 0, SRCCOPY);
    389429end;
    390430
    391431procedure TFramedDlg.InitWindowRegion;
    392432var
    393 r0,r1: HRgn;
    394 begin
    395 if FullCaption then exit;
    396 r0:=CreateRectRgn(0,0,ClientWidth,ClientHeight);
    397 r1:=CreateRectRgn(0,0,CaptionLeft,TitleHeight-NarrowFrame);
    398 CombineRgn(r0,r0,r1,RGN_DIFF);
    399 //DeleteObject(r1);
    400 r1:=CreateRectRgn(ClientWidth-CaptionLeft,0,ClientWidth,TitleHeight-NarrowFrame);
    401 CombineRgn(r0,r0,r1,RGN_DIFF);
    402 //DeleteObject(r1);
    403 if WideBottom then
    404   begin
    405   r1:=CreateRectRgn(0,ClientHeight-(WideFrame-NarrowFrame),CaptionLeft,
    406     ClientHeight);
    407   CombineRgn(r0,r0,r1,RGN_DIFF);
    408   //DeleteObject(r1);
    409   r1:=CreateRectRgn(ClientWidth-CaptionLeft,
    410     ClientHeight-(WideFrame-NarrowFrame),ClientWidth,ClientHeight);
    411   CombineRgn(r0,r0,r1,RGN_DIFF);
    412   //DeleteObject(r1);
    413   end;
    414 SetWindowRgn(Handle,r0,false);
    415 //DeleteObject(r0); // causes crash with Windows 95
    416 end;
    417 
    418 procedure TFramedDlg.FillOffscreen(Left,Top,Width,Height: integer);
    419 begin
    420 Fill(Offscreen.Canvas,Left,Top,Width,Height,SideFrame+(wMaintexture-ClientWidth) div 2,
    421   TitleHeight+(hMaintexture-ClientHeight) div 2);
    422 end;
    423 
     433  r0, r1: HRgn;
     434begin
     435  if FullCaption then
     436    exit;
     437  r0 := CreateRectRgn(0, 0, ClientWidth, ClientHeight);
     438  r1 := CreateRectRgn(0, 0, CaptionLeft, TitleHeight - NarrowFrame);
     439  CombineRgn(r0, r0, r1, RGN_DIFF);
     440  // DeleteObject(r1);
     441  r1 := CreateRectRgn(ClientWidth - CaptionLeft, 0, ClientWidth,
     442    TitleHeight - NarrowFrame);
     443  CombineRgn(r0, r0, r1, RGN_DIFF);
     444  // DeleteObject(r1);
     445  if WideBottom then
     446  begin
     447    r1 := CreateRectRgn(0, ClientHeight - (WideFrame - NarrowFrame),
     448      CaptionLeft, ClientHeight);
     449    CombineRgn(r0, r0, r1, RGN_DIFF);
     450    // DeleteObject(r1);
     451    r1 := CreateRectRgn(ClientWidth - CaptionLeft,
     452      ClientHeight - (WideFrame - NarrowFrame), ClientWidth, ClientHeight);
     453    CombineRgn(r0, r0, r1, RGN_DIFF);
     454    // DeleteObject(r1);
     455  end;
     456  SetWindowRgn(Handle, r0, false);
     457  // DeleteObject(r0); // causes crash with Windows 95
     458end;
     459
     460procedure TFramedDlg.FillOffscreen(Left, Top, Width, Height: integer);
     461begin
     462  Fill(Offscreen.Canvas, Left, Top, Width, Height,
     463    SideFrame + (wMaintexture - ClientWidth) div 2,
     464    TitleHeight + (hMaintexture - ClientHeight) div 2);
     465end;
    424466
    425467procedure CreateOffscreen;
    426468begin
    427 if OffScreen<>nil then exit;
    428 offscreen:=TBitmap.Create;
    429 Offscreen.PixelFormat:=pf24bit;
    430 offscreen.Width:=Screen.Width;
    431 if Screen.Height-yUnused<480 then offscreen.Height:=480
    432 else offscreen.Height:=Screen.Height-yUnused;
    433 offscreen.Canvas.Brush.Style:=bsClear;
    434 end;
    435 
     469  if Offscreen <> nil then
     470    exit;
     471  Offscreen := TBitmap.Create;
     472  Offscreen.PixelFormat := pf24bit;
     473  Offscreen.Width := Screen.Width;
     474  if Screen.Height - yUnused < 480 then
     475    Offscreen.Height := 480
     476  else
     477    Offscreen.Height := Screen.Height - yUnused;
     478  Offscreen.Canvas.Brush.Style := bsClear;
     479end;
    436480
    437481initialization
    438 offscreen:=nil;
    439 OffscreenUser:=nil;
     482
     483Offscreen := nil;
     484OffscreenUser := nil;
    440485
    441486finalization
    442 offscreen.Free;
     487
     488Offscreen.Free;
    443489
    444490end.
    445 
Note: See TracChangeset for help on using the changeset viewer.