Font udseende

søg efter XPmanifest

Sorry har ikke tid, påske frokost you know

Stoney

Jeg kan ikke genskabe problemet, har du noget kode?

stoney>>prøver det, og I know, jeg er selv i lag med flere borde..
kroning>>hehe, jeg kan heller ikke genskabe det på min egen PC men jeg har set at min form ser forkert ud på flere maskiner.
Jeg skal nok sende et eksempel her i næste uge, det er nemlig lidt vigtigt. Og jeg vil også prøve at finde ud af at genskabe det.

stoney>>Jeg er jo ikke interesseret i xp look, bare i at mine labels ser ens ud på min pc og andre pc'ere (eller har jeg misforstået noget med dit søgeord?)

Her er et komplet eksempel:

unit formMain;

interface

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

type
    TfrmMain = class(TForm)
        lbWindowTitle: TLabel;
        bevWindowTitleLine: TBevel;
        butClose: TButton;
        procedure butCloseClick(Sender: TObject);
    private
        procedure WMNCHitTest(var Msg: TWMNCHitTest); message wm_NCHitTest;
    public
        procedure CreateParams(var Params: TCreateParams); override;
    end;

var
    frmMain: TfrmMain;

implementation

{$R *.dfm}


procedure TfrmMain.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := (Params.Style or WS_THICKFRAME);
end; //create params


procedure TfrmMain.WMNCHitTest(var Msg: TWMNCHitTest);
var
    xr,yr:  integer;
    wr,hr:  integer;
begin
    xr:=msg.XPos-left;
    yr:=msg.YPos-top;
    wr:=clientWidth+3;
    hr:=clientHeight+3;

    if xr+12>=wr then  //12 gør de nemmere at ramme hjørnet
        if yr+12>=hr then begin
            msg.Result:=HTBOTTOMRIGHT;
            exit;
        end;

    if xr<=2 then begin
        if yr<=2 then
            msg.Result:=HTTOPLEFT
        else
            if yr+2>=hr then
                msg.Result:=HTBOTTOMLEFT
            else
                msg.Result:=HTLEFT;
        exit;
    end;

    if yr<=2 then begin
        if xr>=wr then
            msg.Result:=HTTOPRIGHT
        else
            msg.Result:=HTTOP;
        exit;
    end;

    if xr>=wr then begin
        if yr+2>=hr then
            msg.Result:=HTBOTTOMRIGHT
        else
            msg.Result:=HTRIGHT;
        exit;
    end;

    if yr>=hr then begin
        msg.Result:=HTBOTTOM;
        exit;
    end;

    if yr <= 23 then begin
        Msg.Result := HTCAPTION;
        exit;
    end;

    msg.Result:=HTCLIENT; //bare formen
end; //hit test


procedure TfrmMain.butCloseClick(Sender: TObject);
begin
    close
end;

end.


Og form'en:

object frmMain: TfrmMain
  Left = 291
  Top = 299
  BorderStyle = bsNone
  Caption = 'frmMain'
  ClientHeight = 237
  ClientWidth = 543
  Color = clWhite
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    543
    237)
  PixelsPerInch = 96
  TextHeight = 13
  object lbWindowTitle: TLabel
    Left = 451
    Top = 1
    Width = 88
    Height = 16
    Alignment = taRightJustify
    Anchors = [akTop, akRight]
    Caption = 'Formular test'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Verdana'
    Font.Style = []
    ParentFont = False
  end
  object bevWindowTitleLine: TBevel
    Left = 0
    Top = 20
    Width = 544
    Height = 2
    Anchors = [akLeft, akTop, akRight]
    Shape = bsBottomLine
  end
  object butClose: TButton
    Left = 470
    Top = 204
    Width = 65
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = '&Luk'
    TabOrder = 0
    OnClick = butCloseClick
  end
end

kroning>>hvad resultat fik du?

stoney>>hvad med det der XPmanifest?

Vil I prøve at løbe efter guldet?

Jeg har prøvet din kode men kan stadig ikke få problemet, har prøvet på 2 maskiner.

kroning>>tak skal du have du har fortjent nogle points bare for det. Jeg har fundet ud af noget mere som jeg lige skal have orden i, så jeg vender tilbage. Håber du også gider følge lidt med?

Kroning>>points?