TGW_Titlebar.pas //need Help!!!

Gothicware · Verfasst: Mi 18.08.04 23:25

Eine Eigne Titelbar, für alle Form.BorderStyle := bsnone Formen.

Hier der Code für GW_Titlebar.pas

Delphi-Quelltext

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;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\
+ TGWTitelbar© by Gothicware          +
+ It's Freeware, but you must but an  +
+ information to/in your program, so  +
+ the user know you use TGWTitlebar   +
\~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{-<#[___http://Gothicware.de.vu___]#>-}

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
    { Public declarations }
  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; // rgb(212,208,200);
     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; //correct it; hope i find a better rutin someday!
mousepos.y := mousepos.y - top - TCustomForm(Owner).top -2; //also not the best way ;-) mail to primaluna@web.de if you know a better way!
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.

Kann mir jemand sagen, wie ich es Anstelle, das TGW_Titlebar immer zuoberst ist???
Wenn man zb.: ein Menü einfügt, dann ist es Über der TGW_TitleBar, was ziemlich lustig aussieht. :wink:

Moderiert von Tino: Code- durch Delphi-Tags ersetzt.

PhilGo · Beiträge: 315 Win 98, Win Longhorn ;-)

Haste mal ein Screen-Shot von einem Selbstversuch mit der Kompo? :wink:

Gruß PhilGo

_________________
Sie werden dich finden und töten... Söhne der großen Bärin!

BenBE · Verfasst: Do 19.08.04 20:45

Ich glaub, es ist einfacher, mit SetWindowLong den Window-Style entsprechend anzupassen. Bei Torry gibt's nen Tipp, wie man von ner bsNormal Form die Captionbar entfernen kann (ohne den Rahmen zu entfernen). Sollte einfach angepasst werden können und sieht IMHO besser aus, als ne bsNone Form mit Caption.

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

Gothicware · Verfasst: Fr 20.08.04 05:12

Gehn tut das am besten, wenn man die Form direkt Manipuliert mit:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

private
 { Private-Deklarationen}
 procedure CreateParams(var Params : TCreateParams); override;
.
.
.
procedure TForm.CreateParams(var Params : TCreateParams);
begin
  Inherited Createparams(Params);
  with Params do
    Style := (Style or WS_POPUP) and not WS_DLGFRAME;
end;

Screenshot:
user defined image

Hoffe das reicht.

Moderiert von Tino: Code- durch Delphi-Tags ersetzt.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme