1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304: 305: 306: 307: 308: 309: 310: 311: 312: 313: 314: 315: 316: 317: 318: 319: 320: 321: 322: 323: 324: 325: 326: 327: 328: 329: 330: 331: 332: 333: 334: 335: 336: 337: 338: 339: 340: 341: 342: 343: 344: 345: 346: 347: 348: 349: 350: 351: 352: 353: 354: 355: 356: 357: 358: 359: 360: 361: 362: 363: 364: 365: 366: 367: 368: 369: 370: 371: 372: 373: 374: 375: 376: 377: 378: 379: 380: 381: 382: 383: 384: 385: 386: 387: 388: 389: 390: 391: 392: 393: 394: 395: 396: 397: 398: 399: 400: 401: 402: 403: 404: 405: 406: 407: 408: 409: 410: 411: 412: 413: 414: 415: 416: 417: 418: 419: 420: 421: 422: 423: 424: 425: 426: 427: 428: 429: 430: 431: 432: 433: 434: 435:
| unit GW_Titlebar;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
const SParentForm = 'You must place the TGWTitlebar on a TCustomForm!';
type TGWTitlebar = class(TCustomControl) private FForm: TCustomForm; FWndProcInstance: Pointer; FDefProc: LongInt; FAktiv: Boolean; FDown: Boolean; FOldX, FOldY: Integer; FAktivTextColor: TColor; FAktivTitlebarColor: TColor; FAktivTitleBarFadeColor: TColor; FInAktivTitlebarColor: TColor; FInAktivTitleBarFadeColor: TColor; FInAktivTextColor: TColor; FBorderColor: TColor; FPaintBorder: Boolean; FAlignment: TAlignment; FOnActivate: TNotifyEvent; FOnDeactivate: TNotifyEvent; FOnCloseButtonClick: TNotifyEvent; procedure FormWndProc(var Message: TMessage); procedure DoActivateMessage(var Message: TWMActivate); procedure DoActivation; procedure DoDeactivation; procedure SetAktivTextColor(Value: TColor); procedure SetAktivTitleBarFadeColor(Value: TColor); procedure SetAktivTitlebarColor(Value: TColor); procedure SetInAktivTitleBarFadeColor(Value: TColor); procedure SetInAktivTitlebarColor(Value: TColor); procedure SetInAktivTextColor(Value: TColor); procedure SetBorderColor(Value: TColor); procedure SetPaintBorder(Value: Boolean); procedure SetAlignment(Value: TAlignment); procedure SetParent(AParent: TWinControl); override; procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED; procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED; protected constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Loaded; override; procedure Paint; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public published property AktivTextColor: TColor read FAktivTextColor write SetAktivTextColor; property AktivTitlebarColor: TColor read FAktivTitlebarColor write SetAktivTitlebarColor; property AktivTitleBarFadeColor: TColor read FAktivTitleBarFadeColor write SetAktivTitleBarFadeColor; property InAktivTitlebarColor: TColor read FInAktivTitlebarColor write SetInAktivTitlebarColor; property InAktivTitleBarFadeColor: TColor read FInAktivTitleBarFadeColor write SetInAktivTitleBarFadeColor; property InAktivTextColor: TColor read FInAktivTextColor write SetInAktivTextColor; property BorderColor: TColor read FBorderColor write SetBorderColor; property PaintBorder: Boolean read FPaintBorder write SetPaintBorder; property Alignment: TAlignment read FAlignment write SetAlignment; property Align; property Font; property Caption; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; property OnCloseButtonClick: TNotifyEvent read FOnCloseButtonClick write FOnCloseButtonClick; end;
var CloseButton: record Rect: TRect; Down,Visible: Boolean; end;
procedure Register;
implementation
constructor TGWTitlebar.Create(AOwner: TComponent); begin inherited Create(AOwner); Width := 100; Height := 22; ControlStyle := ControlStyle + [csAcceptsControls];
AktivTextColor := clWhite; AktivTitlebarColor := $00000040; AktivTitleBarFadeColor := clWhite; Align := alTop; Self.Alignment := taLeftJustify; BorderColor := TCustomForm(Owner).Color; Caption := TCustomForm(Owner).Caption; Font.Style := Font.Style + [fsBold]; InAktivTextColor := clWhite; InAktivTitlebarColor := $00404040; InAktivTitleBarFadeColor := clWhite; PaintBorder := false; CloseButton.Rect.Left := Width - 18; CloseButton.Rect.Top := 2; CloseButton.Rect.Right := Width - 2; CloseButton.Rect.Bottom := Height -2; CloseButton.Visible := True; CloseButton.Down := false; if csDesigning in ComponentState then begin FAktiv := True; end; end;
destructor TGWTitlebar.Destroy; begin inherited Destroy; end;
procedure ColorFade(Canvas: TCanvas; Recty: TRect; fecolor, fbcolor: TColor); var i, j, h, w, fcolors: Integer; R, G, B: Longword; beginRGBvalue, RGBdifference: array[0..2] of Longword; begin beginRGBvalue[0] := GetRvalue(colortoRGB(FBcolor)); beginRGBvalue[1] := GetGvalue(colortoRGB(FBcolor)); beginRGBvalue[2] := GetBvalue(colortoRGB(FBcolor));
RGBdifference[0] := GetRvalue(colortoRGB(FEcolor)) - beginRGBvalue[0]; RGBdifference[1] := GetGvalue(colortoRGB(FEcolor)) - beginRGBvalue[1]; RGBdifference[2] := GetBvalue(colortoRGB(FEcolor)) - beginRGBvalue[2];
Canvas.pen.Style := pssolid; Canvas.pen.mode := pmcopy; j := 0; h := recty.Bottom - recty.Top; w := recty.Right - recty.Left; fcolors := w;
for i := fcolors downto 0 do begin recty.Left := muldiv(i - 1, w, fcolors); recty.Right := muldiv(i, w, fcolors); if fcolors > 1 then begin R := beginRGBvalue[0] + muldiv(j, RGBDifference[0], fcolors); G := beginRGBvalue[1] + muldiv(j, RGBDifference[1], fcolors); B := beginRGBvalue[2] + muldiv(j, RGBDifference[2], fcolors); end; Canvas.Brush.Color := RGB(R, G, B); patBlt(Canvas.Handle, recty.Left, recty.Top, Recty.Right - recty.Left, h, patcopy); Inc(j); end; end;
procedure TGWTitlebar.Loaded; var Wnd: HWND; begin inherited Loaded; if not (csDesigning in ComponentState) and (FForm <> nil) then begin if FForm <> nil then begin Wnd := FForm.Handle; FWndProcInstance := MakeObjectInstance(FormWndProc); FDefProc := SetWindowLong(Wnd,GWL_WNDPROC,LongInt(FWndProcInstance)); end; end; end;
procedure TGWTitlebar.FormWndProc(var Message: TMessage); begin case Message.Msg of WM_ACTIVATE: DoActivateMessage(TWMActivate(Message)); end; Message.Result := CallWindowProc(Pointer(FDefProc),FForm.Handle,Message.Msg,Message.WParam, Message.LParam); end;
procedure TGWTitlebar.DoActivateMessage(var Message: TWMActivate); begin case Message.Active of WA_Active: DoActivation; WA_CLICKActive: DoActivation; WA_INActive: DoDeactivation; end; end;
procedure TGWTitlebar.DoActivation; begin FAktiv := True; Invalidate; if Assigned(FOnActivate) then FOnActivate(Self); end;
procedure TGWTitlebar.DoDeactivation; begin FAktiv := False; Invalidate; if Assigned(FOnDeactivate) then FOnDeactivate(Self); end;
procedure TGWTitlebar.Paint; var iCaptionWidth, iCaptionHeight, iX, iY: Integer; begin case FAktiv of True: ColorFade(Canvas,Rect(0,0,Width,Height),AktivTitlebarColor,AktivTitleBarFadeColor); False: ColorFade(Canvas,Rect(0,0,Width,Height),InAktivTitlebarColor,InAktivTitleBarFadeColor); end; CloseButton.Rect.Left := Width - 18; CloseButton.Rect.Top := 2; CloseButton.Rect.Right := Width - 2; CloseButton.Rect.Bottom := Height -2;
with Canvas do begin with ClientRect do begin Canvas.Font.Assign(Self.Font); case FAktiv of True: Canvas.Font.Color := FAktivTextColor; False: Canvas.Font.Color := FInAktivTextColor; end; iCaptionWidth := TextWidth(Caption); iCaptionHeight := TextHeight(Caption); if PaintBorder then begin Pen.Color := BorderColor; Moveto(0,0); Lineto(Width-1,0); Lineto(Width-1,Height-1); Lineto(0,Height-1); Lineto(0,0); end; Brush.Style := bsClear; if Alignment = taCenter then begin iX := Width div 2 - iCaptionWidth div 2; iY := Height div 2 - iCaptionHeight div 2; TextOut(iX,iY,Caption); end else if Alignment = taRightJustify then begin iX := Width - iCaptionWidth -3; iY := Height div 2 - iCaptionHeight div 2; TextOut(iX,iY,Caption); end else begin iX := 2; iY := Height div 2 - iCaptionHeight div 2; TextOut(iX,iY,Caption); end;
end; if CloseButton.Visible then begin Pen.Color := clwhite; Brush.Color := clBtnFace; Brush.Style := bsSolid; Rectangle(CloseButton.Rect.Left,CloseButton.Rect.Top,CloseButton.Rect.Right,CloseButton.Rect.Bottom); Pen.Color := rgb(64,64,64); moveto(CloseButton.Rect.Right -1,CloseButton.Rect.Top); lineto(CloseButton.Rect.Right -1,CloseButton.Rect.Bottom -1); lineto(CloseButton.Rect.Left-1,CloseButton.Rect.Bottom -1); Pen.Color := rgb(128,128,128); moveto(CloseButton.Rect.Right -2,CloseButton.Rect.Top +1); lineto(CloseButton.Rect.Right -2,CloseButton.Rect.Bottom -2); lineto(CloseButton.Rect.Left,CloseButton.Rect.Bottom -2); Pen.Color := clBlack;
moveto(CloseButton.Rect.Left +4,CloseButton.Rect.Top +3); Lineto(CloseButton.Rect.Right -5,CloseButton.Rect.Bottom -4);
moveto(CloseButton.Rect.Left +5,CloseButton.Rect.Top +3); Lineto(CloseButton.Rect.Right -4,CloseButton.Rect.Bottom -4);
moveto(CloseButton.Rect.Left +4,CloseButton.Rect.Bottom -5); Lineto(CloseButton.Rect.Right -5,CloseButton.Rect.Top +2);
moveto(CloseButton.Rect.Left +5,CloseButton.Rect.Bottom -5); Lineto(CloseButton.Rect.Right -4,CloseButton.Rect.Top +2);
end;
end; end;
procedure TGWTitlebar.MouseMove; begin ReleaseCapture; SendMessage(TCustomForm(Owner).Handle, WM_SYSCOMMAND, $F012, 0); end;
procedure TGWTitlebar.MouseUp; begin if Closebutton.Down then CloseButton.Down := false; end;
procedure TGWTitlebar.MouseDown; var mousepos : TPoint; begin GetCursorPos(mousepos); mousepos.x := mousepos.x - left - TCustomForm(Owner).left -3; mousepos.y := mousepos.y - top - TCustomForm(Owner).top -2; if mousepos.x > CloseButton.Rect.Left then if mousepos.x < CloseButton.Rect.Right then if mousepos.y > CloseButton.Rect.Top then if mousepos.y < CloseButton.Rect.Bottom then FOnCloseButtonClick(Self); end;
procedure TGWTitlebar.SetAktivTextColor(Value: TColor); begin if Value <> FAktivTextColor then begin FAktivTextColor := Value; Invalidate; end; end;
procedure TGWTitlebar.SetInAktivTextColor(Value: TColor); begin if Value <> FInAktivTextColor then begin FInAktivTextColor := Value; Invalidate; end; end;
procedure TGWTitlebar.SetAktivTitlebarColor(Value: TColor); begin if Value <> FAktivTitlebarColor then begin FAktivTitlebarColor := Value; Invalidate; end; end;
procedure TGWTitlebar.SetInAktivTitlebarColor(Value: TColor); begin if Value <> FInAktivTitlebarColor then begin FInAktivTitlebarColor := Value; Invalidate; end; end;
procedure TGWTitlebar.SetBorderColor(Value: TColor); begin if Value <> FBorderColor then begin FBorderColor := Value; Invalidate; end; end;
procedure TGWTitlebar.SetPaintBorder(Value: Boolean); begin if Value <> FPaintBorder then begin FPaintBorder := Value; Invalidate; end; end;
procedure TGWTitlebar.SetAktivTitleBarFadeColor(Value: TColor); begin if Value <> FAktivTitleBarFadeColor then begin FAktivTitleBarFadeColor := Value; Invalidate; end; end;
procedure TGWTitlebar.SetInAktivTitleBarFadeColor(Value: TColor); begin if Value <> FInAktivTitleBarFadeColor then begin FInAktivTitleBarFadeColor := Value; Invalidate; end; end;
procedure TGWTitlebar.SetAlignment(Value: TAlignment); begin if Value <> FAlignment then begin FAlignment := Value; Invalidate; end; end;
procedure TGWTitlebar.SetParent(AParent: TWinControl); begin if (AParent <> nil) and not(AParent is TCustomForm) then raise EInvalidOperation.Create(SParentForm); FForm := TCustomForm(AParent); inherited; end;
procedure TGWTitlebar.CMFontChanged (var Message: TMessage); begin Invalidate; end;
procedure TGWTitlebar.CMTextChanged (var Message: TMessage); begin Invalidate; end;
procedure Register; begin RegisterComponents('Gothicware', [TGWTitlebar]); end;
end. |