PDA

View Full Version : سوال: وسط چین کردن تکست کپشن فرم.



Mask
دوشنبه 03 بهمن 1390, 14:23 عصر
سلام.
میخاستم بدونم چطوری میشه کپشن فرم رو دقیقا وسط قرار بدیم.
یعنی مد سنتر باشه.

سعید صابری
دوشنبه 03 بهمن 1390, 15:27 عصر
این یه جایی نوشته بود امتحان کن کار میکنه

private
{ Private declarations }
FCaption : string;
procedure DrawCaption;
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPaint;
procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;

...


procedure TForm1.FormCreate(Sender: TObject);
begin
FCaption := Caption; //store the caption
Caption := ' '; //set caption to ' ' (hide it)
end;

procedure SetFontToCaptionFont(fFont: TFont);
var
NCM : TNONCLIENTMETRICS;
NewFHnd : longint;
begin
NCM.cbSize := SizeOf(TNONCLIENTMETRICS);
if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCM, 0) then begin
{set Font to the retrieved font}
NewFHnd := CreateFontIndirect(NCM.lfCaptionFont);
if (NewFHnd <> 0) then fFont.Handle := NewFHnd;
end;
end;

procedure TForm1.DrawCaption;
var
yFrame,
ySize : Integer;
r : TRect;
begin
//Height of Sizeable Frame
yFrame := GetSystemMetrics(SM_CYFRAME);

//Height of Caption Buttons
ySize := GetSystemMetrics(SM_CYSIZE);

//Get the handle to canvas using Form's device context
Canvas.Handle := GetWindowDC(Self.Handle);
try
SetFontToCaptionFont(Canvas.Font);
Canvas.Font.Color := clWhite;
Canvas.Brush.Style := bsClear;

r := Rect(0, yFrame, Width, yFrame +ySize);
DrawText(Canvas.Handle, PChar(FCaption), -1, r,
DT_SINGLELINE OR DT_CENTER OR DT_VCENTER OR DT_NOPREFIX);
finally
//Get rid of the device context and set the canvas handle to default
ReleaseDC(Self.Handle, Canvas.Handle);
Canvas.Handle := 0;
end;
end;

//This traps the default form painting
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
inherited;
DrawCaption;
end;

//This traps form activation
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
inherited;
DrawCaption;
end;

//This traps any text being sent to the window
procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
inherited;
DrawCaption;
end;

//Have to perform an NC_ACTIVATE when the form is resized
//so that the caption bar and button are redrawn. This is
//necessary because Win95/NT4+ draw all buttons relative to the
//right side of a window.
procedure TForm1.FormResize(Sender: TObject);
begin
//Force a redraw of caption bar if form is resized
Perform(WM_NCACTIVATE, Word(Active), 0);
end;

Mask
دوشنبه 03 بهمن 1390, 16:01 عصر
ممنون. واسه Xp کار میده اما سون نه.
من واسه سون میخام.