Højrestilling af caption på formen

Kan du bruge noget af dette?

procedure TForm1.RedrawCaption;
var
  LabelHeight, LabelWidth, LabelTop: Integer;
  Caption_Height, Border3D_Y, Button_Width, Border_Thickness: Integer;
  TitleCanvas: TCanvas;
  CaptionBarRect: TRect;
begin
  TitleCanvas := TCanvas.Create;
  TitleCanvas.Handle := GetWindowDC(Handle);
  Border3D_Y := GetSystemMetrics(SM_CYEDGE);
  Button_Width := GetSystemMetrics(SM_CXSIZE);
  Border_Thickness  := GetSystemMetrics(SM_CYSIZEFRAME);
  Caption_Height := GetSystemMetrics(SM_CYCAPTION);
  LabelWidth := Canvas.TextWidth(Caption);
  LabelHeight := Canvas.TextHeight(Caption);
  LabelTop := LabelHeight - Caption_Height div 2;
  CaptionBarRect := Rect(Border_Thickness + Border3D_Y + Button_Width,
                        Border_Thickness + Border3D_Y,
                        Width - (Border_Thickness + Border3D_Y) - Button_Width * 4,
                        Caption_Height);
  TitleCanvas.Brush.Style := bsClear;
  TitleCanvas.Font.Color := clCaptionText;
  TitleCanvas.Font.Name := 'MS Sans Serif';
  TitleCanvas.Font.Style := [fsBold];
  DrawText(TitleCanvas.Handle, PChar(Caption), Length(Caption), CaptionBarRect,
          DT_CENTER or DT_SINGLELINE or DT_VCENTER);
end;

nca >>> Joh, tak, det ligner det, jeg søger efter.

Der er ikke lavt meget om i den følgende kode - kun nogle finindstillinger. Og det virker. Men hver gang formen mister fokus (ALT+TAB eller formen minimeres), forsvinder den tekst, jeg lige har malet :(

procedure TFormMain.FormResize(Sender: TObject);
var
  LabelHeight, LabelWidth, LabelTop: Integer;
  Caption_Height, Border3D_Y, Button_Width, Border_Thickness: Integer;
  TitleCanvas: TCanvas;
  CaptionBarRect: TRect;
  newCaption: TCaption;
begin
  newCaption := 'A'' roder lidt mæ'' rytmeboksen ...';
  TitleCanvas := TCanvas.Create;
  TitleCanvas.Handle := GetWindowDC(Handle);
  Border3D_Y := GetSystemMetrics(SM_CYEDGE);
  Button_Width := GetSystemMetrics(SM_CXSIZE);
  Border_Thickness  := GetSystemMetrics(SM_CYSIZEFRAME);
  Caption_Height := GetSystemMetrics(SM_CYCAPTION);
  LabelWidth := Canvas.TextWidth(newCaption);
  LabelHeight := Canvas.TextHeight(newCaption);
//  LabelTop := LabelHeight - Caption_Height div 2;
  LabelTop := (Caption_Height - LabelHeight) div 2;
  CaptionBarRect := Rect(Border_Thickness + Border3D_Y + Button_Width,
                        Border_Thickness + Border3D_Y,
                        Width - (Border_Thickness + Border3D_Y) - Button_Width * 3,
                        Caption_Height);
  TitleCanvas.Brush.Style := bsClear;
  TitleCanvas.Font.Color := clBlack; //clCaptionText;
  TitleCanvas.Font.Name := 'MS Sans Serif';
  TitleCanvas.Font.Style := [fsBold];
  DrawText(TitleCanvas.Handle, PChar(newCaption), Length(newCaption), CaptionBarRect,
          DT_RIGHT or DT_SINGLELINE or DT_VCENTER);
  ReleaseDC(Handle, TitleCanvas.Handle);
  TitleCanvas.Free;
end;

Du skal kalde koden i formens onResize event, så virker det (med undtagelse at caption også skrives på den originale plads).

hrc >>> Det er i formens OnResize, jeg kalder koden (TFormMain.FormResize(...))

Jeg har sat formens caption til "Mit program" og tegner så kun "Copyright: Mig" højrestillet (DT_RIGHT) i TitleCanvas.

Den her version kan klare fokus skift - teksten kommer bare til at stå på hvid baggrund ... hmmm ...



unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TFormMain = class(TForm)
    procedure PaintCopyright(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    CopyrightCaption: TCaption;
    CopyrightCanvas: TCanvas;
    CopyrightHeight, CopyrightWidth, CopyrightTop: Integer;
    FormCaptionHeight, FormCaptionButtonWidth, FormBorderThickness: Integer;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  FormCaptionHeight := GetSystemMetrics(SM_CYCAPTION);
  FormCaptionButtonWidth := GetSystemMetrics(SM_CXSIZE);
  FormBorderThickness := GetSystemMetrics(SM_CYSIZEFRAME) + GetSystemMetrics(SM_CYEDGE);
  CopyrightCanvas := TCanvas.Create;
  CopyrightCanvas.Brush.Style := bsClear;
  CopyrightCanvas.Font.Color := clBlack; //clCaptionText;
  CopyrightCanvas.Font.Name := 'MS Sans Serif';
  CopyrightCanvas.Font.Style := [fsBold];
  CopyrightCaption := 'Copyright : sloWaterz';
  CopyrightWidth := Canvas.TextWidth(CopyrightCaption);
  CopyrightHeight := Canvas.TextHeight(CopyrightCaption);
  CopyrightTop := (FormCaptionHeight - CopyrightHeight) div 2;
  Application.OnActivate := PaintCopyright;
  Application.OnRestore := PaintCopyright;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CopyrightCanvas.Free;
end;

procedure TFormMain.PaintCopyright(Sender: TObject);
var
  copyrightRect: TRect;
begin
  CopyrightCanvas.Handle := GetWindowDC(Handle);
  copyrightRect := Rect(FormBorderThickness + FormCaptionButtonWidth,
                        FormBorderThickness,
                        Width - FormBorderThickness - FormCaptionButtonWidth * 3,
                        FormCaptionHeight);
  DrawText(CopyrightCanvas.Handle, PChar(CopyrightCaption), Length(CopyrightCaption),
          copyrightRect, DT_RIGHT or DT_SINGLELINE or DT_VCENTER);
  ReleaseDC(Handle, CopyrightCanvas.Handle);
end;

end.

I mit lille komponent kan man også have en popup menu til når man højere klikker oppe i Caption bared .. Blot prop en alm popup menu på din form og Assign den til komponenten og du er i luften !!!!

Jens B

Hmmn .. Skod eksperten åd mit svar !!!!

Ovenstående kommentar skal læses bagefter dette svar :o)

Nå I gør det altså forkert ... Jammen det virker jo .. Det kan godt være men det er altså forkert !

Svaret er SubCalssing !!!! Det betyder i alt sin enkelthed at du overtager et vindues event kø og processer den selv !! Det er den måse som Borland har gjort for at få VCL'en til at virke og det er den måde det her skal gøres. !

Jeg har skrevet et lille komponent der kan subcalsse Caption baren på en form (!) Det fede ved dette er at det hele er event drevet således at Componentet selv sørger for at tegne Teksten op når dwet er krævet !

hvis du subcalsser kan du ensdda sætte nye farver oppe i baren, Lave nye knapper placere den hvor du har lyst ! Etc ...

Og lave en popup menu også (se ovenfor)æ
Det hele er indkapslet i et komponent du bare klasker på din form og vuptti så er du i luften !

Den der med teksten har jeg lavet en halv hjertet løsning på ... Det var slet ikke tænkt på da jeg skrev kompnenten, men det kan du sikkert nemt hacke på plads selv.

Componenten, Demo, source samt exefil kan downloades her :
http://borrisholt.com/eksperten/CapCtrl.zip

Jens B

Der er sq ikke meget gang i jer hva ?

Jens B

Borrisholt: De points har du måtte vente længe på...

Ja, det tog lidt tid  :D

Jeg var lige i gang med lidt forårsrengøring. Også lettere forsinket  ;)