controls/panel/MCKmdvPanel.pas

   1 unit MCKmdvPanel;
   2
   3 interface
   4
   5 uses Windows, Messages, Classes, mckCtrls, KOL, Controls, mirror, KOLmdvPanel, Graphics;
   6
   7 type
   8
   9   TKOLmdvPanel = class(TKOLPanel)
  10   private
  11     FBevelOuter: TBevelCut;
  12     FBevelInner: TBevelCut;
  13     FBevelWidth: Word;
  14     FBorderWidth: Word;
  15     FBorderStyle: TBorderStyle;
  16     FNone: Boolean;
  17     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  18     procedure SetBevelInner(const Value: TBevelCut);
  19     procedure SetBevelOuter(const Value: TBevelCut);
  20     procedure SetBevelWidth(const Value: Word);
  21     procedure SetBorderWidth(const Value: Word);
  22     procedure SetBorderStyle(const Value: TBorderStyle);
  23
  24     procedure UpdateBorder;
  25   protected
  26     procedure Set_VA(const Value: TVerticalAlign); override;
  27     function AdditionalUnits: string; override;
  28     procedure SetupConstruct( SL: TStringList; const AName, AParent, Prefix: String ); override;
  29     function SetupParams( const AName, AParent: String ): String; override;
  30
  31     procedure Paint; override;
  32     procedure CreateParams(var Params: TCreateParams); override;
  33   public
  34     constructor Create(AOwner: TComponent); override;
  35     destructor Destroy; override;
  36   published
  37     property BevelOuter: TBevelCut read FBevelOuter write SetBevelOuter;
  38     property BevelInner: TBevelCut read FBevelInner write SetBevelInner;
  39     property BevelWidth: Word read FBevelWidth write SetBevelWidth;
  40     property BorderWidth: Word read FBorderWidth write SetBorderWidth;
  41     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
  42
  43     property edgeStyle: Boolean read FNone;
  44     property Border: Boolean read FNone;
  45   end;
  46
  47 procedure Register;
  48
  49 implementation
  50
  51 {$R *.dcr}
  52
  53 procedure Register;
  54 begin
  55   RegisterComponents( 'KOL Additional', [TKOLmdvPanel]);
  56 end;
  57
  58 { TKOLmdvPanel }
  59
  60 function TKOLmdvPanel.AdditionalUnits: string;
  61 begin
  62     Result := ', KOLmdvPanel';
  63 end;
  64
  65 constructor TKOLmdvPanel.Create(AOwner: TComponent);
  66 begin
  67     inherited;
  68     BevelOuter:= bvRaised;
  69     BevelInner:= bvNone;
  70     BevelWidth:= 1;
  71     BorderWidth:= 0;
  72     BorderStyle:= bsNone;
  73     Width:= 105; Height:= 105;
  74     inherited edgeStyle:= esNone;
  75 end;
  76
  77 procedure TKOLmdvPanel.CreateParams(var Params: TCreateParams);
  78 const BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
  79 begin
  80   inherited CreateParams(Params);
  81     with Params do
  82     begin
  83       Style := Style and (not WS_BORDER); ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
  84       Style := Style or BorderStyles[FBorderStyle];
  85       if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  86       begin
  87         Style := Style and not WS_BORDER;
  88         ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  89       end;
  90       WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  91     end;
  92 end;
  93
  94 destructor TKOLmdvPanel.Destroy;
  95 begin
  96
  97   inherited;
  98 end;
  99
 100 procedure Frame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor; Width: Integer);
 101   procedure DoRect;
 102   var
 103     TopRight, BottomLeft: TPoint;
 104   begin
 105     with Canvas, Rect do
 106     begin
 107       TopRight.X := Right;
 108       TopRight.Y := Top;
 109       BottomLeft.X := Left;
 110       BottomLeft.Y := Bottom;
 111       Pen.Color := TopColor;
 112       PolyLine([BottomLeft, TopLeft, TopRight]);
 113       Pen.Color := BottomColor;
 114       Dec(BottomLeft.X);
 115       PolyLine([TopRight, BottomRight, BottomLeft]);
 116     end;
 117   end;
 118
 119 begin
 120   Canvas.Pen.Width := 1;
 121   Dec(Rect.Bottom); Dec(Rect.Right);
 122   while Width > 0 do
 123   begin
 124     Dec(Width);
 125     DoRect;
 126     InflateRect(Rect, -1, -1);
 127   end;
 128   Inc(Rect.Bottom); Inc(Rect.Right);
 129 end;
 130
 131 procedure TKOLmdvPanel.Paint;
 132 const Alignments: array[TTextAlign] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
 133       VAlignments: array[TVerticalAlign] of Longint = (DT_TOP, DT_VCENTER, DT_BOTTOM);
 134 var
 135   Rect: TRect;
 136   TopColor, BottomColor: TColor;
 137   Flags: Longint;
 138
 139   procedure AdjustColors(Bevel: KOLmdvPanel.TBevelCut);
 140   begin
 141     TopColor := clBtnHighlight;
 142     if Bevel = KOLmdvPanel.bvLowered then TopColor := clBtnShadow;
 143     BottomColor := clBtnShadow;
 144     if Bevel = KOLmdvPanel.bvLowered then BottomColor := clBtnHighlight;
 145   end;
 146
 147 begin
 148     Rect := GetClientRect;
 149     if BevelOuter <> KOLmdvPanel.bvNone then
 150     begin
 151       AdjustColors(BevelOuter);
 152       Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
 153     end;
 154     Frame3D(Canvas, Rect, Color, Color, BorderWidth);
 155     if BevelInner <> KOLmdvPanel.bvNone then
 156     begin
 157       AdjustColors(BevelInner);
 158       Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
 159     end;
 160     with Canvas do
 161     begin
 162       Brush.Color := Color;
 163       FillRect(Rect);
 164       Brush.Style := bsClear;
 165       PrepareCanvasFontForWYSIWIGPaint(Canvas);
 166       Flags := DT_EXPANDTABS or DT_SINGLELINE or VAlignments[VerticalAlign] or Alignments[TextAlign];
 167       DrawText(Handle, PChar(Caption), -1, Rect, Flags);
 168     end;
 169 end;
 170
 171 procedure TKOLmdvPanel.SetBevelInner(const Value: KOLmdvPanel.TBevelCut);
 172 begin
 173     FBevelInner := Value;
 174     UpdateBorder;
 175     Invalidate;
 176     Change;
 177 end;
 178
 179 procedure TKOLmdvPanel.SetBevelOuter(const Value: KOLmdvPanel.TBevelCut);
 180 begin
 181     FBevelOuter := Value;
 182     UpdateBorder;
 183     Invalidate;
 184     Change;
 185 end;
 186
 187 procedure TKOLmdvPanel.SetBevelWidth(const Value: Word);
 188 begin
 189     FBevelWidth := Value;
 190     UpdateBorder;
 191     Invalidate;
 192     Change;
 193 end;
 194
 195 procedure TKOLmdvPanel.SetBorderStyle(const Value: TBorderStyle);
 196 begin
 197   if FBorderStyle <> Value then
 198   begin
 199     FBorderStyle := Value;
 200     UpdateBorder;
 201     RecreateWnd;
 202   end;
 203   Change;
 204 end;
 205
 206 procedure TKOLmdvPanel.SetBorderWidth(const Value: Word);
 207 begin
 208     FBorderWidth := Value;
 209     UpdateBorder;
 210     Invalidate;
 211     Change;
 212 end;
 213
 214 procedure TKOLmdvPanel.SetupConstruct(SL: TStringList; const AName, AParent, Prefix: String);
 215 begin
 216     SL.Add( Prefix + AName + ' := PmdvPanel( New' + TypeName + '( ' + SetupParams( AName, AParent ) + ' )' + GenerateTransparentInits + ');');
 217 end;
 218
 219 function TKOLmdvPanel.SetupParams(const AName, AParent: String): String;
 220 const  EdgeStyles: array[TEdgeStyle] of String =('esRaised', 'esLowered', 'esNone');
 221        BevelCuts: array[TBevelCut] of String =('bvNone', 'bvLowered', 'bvRaised', 'bvSpace');
 222        BorderStyles: array[TBorderStyle] of String =('bsNone', 'bsSingle');
 223 begin
 224     Result := AParent + ', ' + BevelCuts[BevelOuter] + ', ' +
 225                                BevelCuts[BevelInner] + ', ' + Int2Str(BevelWidth) + ', ' +
 226                                BorderStyles[BorderStyle] + ', ' + Int2Str(BorderWidth);
 227 end;
 228
 229 procedure TKOLmdvPanel.Set_VA(const Value: TVerticalAlign);
 230 begin
 231     FVerticalAlign:= Value;
 232     Invalidate;
 233     Change;
 234 end;
 235
 236 procedure TKOLmdvPanel.UpdateBorder;
 237 begin
 238     inherited Border:= FBorderWidth + BevelWidth*Ord(BevelOuter <> bvNone) + BevelWidth*Ord(BevelInner <> bvNone);
 239     Invalidate;
 240 end;
 241
 242 procedure TKOLmdvPanel.WMSize(var Message: TWMSize);
 243 begin
 244     inherited;
 245     Invalidate;
 246 end;
 247
 248 end.