程式學: 顯示型元件

顯示具有 顯示型元件 標籤的文章。顯示所有文章

星期四, 1月 05, 2012

hint提示設定

Application.HintPause:=500;{延遲時間}
Application.HintColor:=$00CEF3E7;{提示的顏色}
Application.HintHidePause:=10000;{提示時間}
Application.HintShortPause:=100;{兩個提示中間的間隔}

星期三, 12月 17, 2008

pagecontrol每個tabsheet都是用動態建立的form，節省記憶體

新增一個TPageControl，以及一個TLMDFormDisplay，並將他name命名為fdMainScreen


procedure TForm1.DisplaySimpleForm(ccFormClass:TComponentClass);
begin
  try
    fdMainScreen.UnLoad();
    fdMainScreen.Parent := PageControl1.ActivePage;
    fdMainScreen.Execute(TForm(ccFormClass.Create(Application)));
  except
    exit;
  end;

end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
  Screen.Cursor := crHourGlass ;
  try
    case PageControl1.ActivePageIndex+1 of
      1 :
        DisplaySimpleForm(TForm2      );
      2 :
        DisplaySimpleForm(TForm3      );
      3 :
        fdMainScreen.UnLoad();
    end;
  finally
    Screen.Cursor := crDefault ;
  end;
end;

星期三, 4月 23, 2008

如何讓Button上的文字顯示二行以上

首先將Button1屬性WordWrap設為true
方法1：
在Object Inspector去點兩下修改Button的Caption，
記得使用Ctrl+Enter來換行喔!!

方法2：
接下來按ALT+F12去編輯dfm的檔案
去搜尋到Button1的caption去編輯
如：
'AAA'+#13#10+'BBB'

星期五, 4月 18, 2008

截取當前的視窗(不是全螢幕)


procedure TForm1.Button1Click(Sender: TObject);
var
  HWND:THandle;
  dc:HDC ;
  rect:TRect ;
  dest:TBitmap;
  jpg :TJpegImage;
  w, h : integer;
begin
  HWND:=handle;
  GetWindowRect(HWND,rect);
  dc:=GetWindowDC(HWND);
  dest := TBitmap.Create;
  jpg :=  TJpegImage.create;
  w := rect.Right-rect.Left;
  h := rect.Bottom-rect.Top;
  dest.Width := w;
  dest.height := h;
  try
    BitBlt(dest.canvas.handle,0,0,w,h,dc,0,0,SRCCOPY );
    jpg.Assign(dest);
    jpg.CompressionQuality:=100;
    jpg.JPEGNeeded;
    jpg.Compress;
    jpg.SaveToFile('c:\1.jpg');
  finally
    ReleaseDC(HWND,dc);
    jpg.free;
    dest.Free;
  end;
end;

星期二, 4月 08, 2008

星期二, 3月 04, 2008

使按鈕能有下壓(凹下去)的效果

使用SpeedButton元件，但注意屬性要設定對喔：
AllowAllUp = true;
Down = true;(設定凹下去或凸出來)
GroupIndex = 1;

星期五, 1月 18, 2008

取得目前(所有)的螢幕解析度及色彩

目前


procedure TForm1.Button1Click(Sender: TObject);
var
    dm: TDeviceMode;
    Mode: string;
begin
    Memo1.Clear;
    Mode := '';

    EnumDisplaySettings(nil, High(DWORD)-1, dm);
    Mode := IntToStr(dm.dmBitsPerPel) + ' Bits Per Pixel ' +
            IntToStr(dm.dmPelsWidth) + ' x ' +
            IntToStr(dm.dmPelsHeight);
    memo1.lines.Add(Mode);
end;


procedure GetVideoModes(ModeList: TStrings);
var
    i, j: integer;
    MoreModes,
    AddMode: boolean;
    dm: TDeviceMode;
    Mode: string;
begin
    ModeList.Clear;
    MoreModes := True;
    Mode := '';
    i := 0;
    while MoreModes do
    begin
        MoreModes := EnumDisplaySettings(nil, i, dm);
        Mode := IntToStr(dm.dmBitsPerPel) + ' Bits Per Pixel ' +
        IntToStr(dm.dmPelsWidth) + ' x ' +
        IntToStr(dm.dmPelsHeight);
        AddMode := True;
        { Check to make sure this mode is not already in the list. }
        for j := 0 to ModeList.Count-1 do
        if Mode = ModeList[j] then
        AddMode := False;
        if AddMode then
        ModeList.Add(Mode);
        Inc(i);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetVideoModes(memo1.lines);
end;

星期二, 12月 25, 2007

新增一個圖片式的進度列

有ProgressBar、Gauge、LMDProgressFill及cxProgressBar元件可用，其中若要有底圖可用LMDProgressFill，並在屬性FillObject用Bitmap的方式，並記得TileMode改為tmStretch


procedure TForm1.WebBrowser1ProgressChange(ASender: TObject; Progress,
  ProgressMax: Integer);
begin
  Gauge1.MaxValue :=ProgressMax;
  Gauge1.Progress:=progress;

  LMDProgressFill1.MaxValue :=ProgressMax;
  LMDProgressFill1.UserValue := PROGRESS;

  cxProgressBar1.Properties.Max:=  ProgressMax;
  cxProgressBar1.position:=progress;
end;

星期五, 12月 21, 2007

能使得視窗form半透明效果


procedure   TForm1.FormCreate(Sender:   TObject);   
var   l:longint;   
begin     
  l:=getWindowLong(Handle,   GWL_EXSTYLE);     
  l := l Or WS_EX_LAYERED;      
  SetWindowLong   (handle,   GWL_EXSTYLE,   l);   
  SetLayeredWindowAttributes   (handle,   0,   180,   LWA_ALPHA);   
end

星期四, 12月 20, 2007

TLabel內的文字要在其寬度的中間顯示，要如何做呢

在TLabel屬性設置：
Alignment := taCenter;
Autosize := false;

星期一, 12月 17, 2007

要如何在memo1中對齊文字

首先你要將memo1的字型設成"細明體" or "Courier New" or "Fixedsys"
然後用Format的方式去%s設定字串格式即可

星期五, 12月 14, 2007

上下兩個panel要同樣高度時(在放大也一樣)

上下兩個panel初始高度在介面設成一樣，上面的panel1為altop，下面為alclient，然後在form的Resize事件加入下面程式碼即可。


procedure TForm1.FormResize(Sender: TObject);   
begin  
  panel1.Height := form1.clientheight div 2;
end;

星期四, 12月 13, 2007

動態為所有TLabel加Caption上去

這個功能主要是給，你一次有太多的TLabel要用for迴圈給值，但是你又不想用動能新增的方式，因為每個位置如果都差異很大，還要一個一個給，所以你就可以用讀入form內所有的物件，在此我又針對爸爸在在Tabsheet1才去判斷。


unit Unit1;

interface

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

const
  lb : array [1..4, 1..2] of string = (('Label1', '3'), ('Label2', '29'), ('Label3', '63'), ('Label4', '35'));

type
  TForm1 = class(TForm)
    Button1: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  i,j       : integer;
  sStr    : string;
  proInfo : PPropInfo;
begin
  j:=1;

  for i:=0 to Componentcount-1 do
  begin
    if TControl(Components[i]).Parent = TabSheet1 then   //找他爸
    begin
      proInfo := GetPropInfo(Components[i].ClassInfo, 'Caption'); //得到有Caption的物件
      if (proInfo <> nil) then
      begin
        if Components[i].name = lb[j][1] then
        begin
          sStr := inttostr(j);
          SetStrProp(Components[i], proInfo, sStr);
          j:=j+1;
        end;
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

  showmessage(inttostr(TabSheet1.ComponentCount));
end;

end.

星期五, 11月 30, 2007

能自動關閉的訊息視窗

加到common.pas內


procedure ShowMsg(const STitle,SText:String; const ITimeOut:Integer);
var
  aFrm:TForm2;
begin
  aFrm:=TForm2.Create(nil);
  aFrm.Caption := STitle;
  aFrm.Label1.Caption := SText;
  aFrm.Timer1.Interval := ITimeOut;
  try
    aFrm.ShowModal;
  finally
    aFrm.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMsg('訊息測試','訊息內容................',4000);
end;

新增1個TButton，1個TLabel，2個Timer(1個顯示用interval用1000，2個enabled用false，並都加入事件)


unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Button1: TButton;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    i : integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  i := Timer1.Interval div 1000;
  Button1.Caption := 'OK ('+inttostr(i)+')';
  Timer2.Enabled := true;
  Timer1.Enabled := true;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  Timer2.Enabled := false;
  Timer1.Enabled := false;
  self.close;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  self.close;
end;

procedure TForm2.Timer2Timer(Sender: TObject);
begin
  Dec(i);
  Button1.Caption := 'OK ('+inttostr(i)+')';
end;

end.

星期一, 11月 26, 2007

讓視窗程式開啟時，位置在螢幕的中間偏上

通常是設定在position屬性=poScreenCenter，但是那個是正中間，對於一般人的眼睛視線應該是中間偏上比較息慣，所以你可以在FormShow時加入下列程式碼：


procedure TForm1.FormShow(Sender: TObject);
begin
  left := (screen.Width - Width) div 2; //等寬
  top :=  (screen.Height - Height)*1 div 3; //高度偏上
end;

星期四, 11月 22, 2007

一個TLabel文字用不同顏色

首先在Label1的Caption文字設定 '台灣股票漲▲▼ 36.52'
然後在你要變化的事件加入


Label1.Canvas.Font.Color := clBlue;
Label1.Canvas.textout(Label1.Canvas.TextWidth('台灣股票 漲'),0,'▲');

//另外一種寫法，記得前面不可用Label1.Caption否則要按兩次才可以顯示
Label1.Canvas.TextOut(0,0,'台灣股票 漲▲546.3');
Label1.canvas.Font.Color:=RGB(255,45,45);
Label1.Canvas.TextOut(Label1.Canvas.TextWidth('台灣股票 漲'),0,'▲');

星期四, 11月 08, 2007

如何使TProgressBar與TStatusBar結合在一起

新增1個TButoon、1個TProgressBar及1個TStatusBar
事件加入FormCreate及OnDrawPanel


procedure TForm1.Button1Click(Sender: TObject);
var
  i : integer;
begin
  ProgressBar1.Position := 0;
  ProgressBar1.Max := 100;

  for i := 0 to 100 do
  begin
    ProgressBar1.Position := i;
    Sleep(25);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 ProgressBarStyle : integer;
begin
 //將狀態列的第二塊面板設為的自繪（即psOwnerDraw）
 StatusBar1.Panels[1].Style := psOwnerDraw;

 //將進程條放入狀態列
 ProgressBar1.Parent := StatusBar1;

 //去除狀態列的邊框，這樣就與狀態列溶為一體了
 ProgressBarStyle := GetWindowLong(ProgressBar1.Handle,GWL_EXSTYLE);
 ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;
 SetWindowLong(ProgressBar1.Handle, GWL_EXSTYLE, ProgressBarStyle);
end;

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
begin
    progressbar1.BoundsRect:=rect;
end;

CheckBox
可以拿來做複選的方式。重要屬性如下：
checked : true 或 false ，gray及unchecked皆為 false，而 checked 為 true。
state : 如果 allowgrayed為true，則有三種狀態
type TCheckBoxState = (cbUnchecked, cbChecked, cbGrayed);
allowgrayed：是否需要灰階的選項
常用程式碼


function showState(state: TCheckBoxState):string;
begin
   case state of
     cbUnchecked : result:='unchecked';
     cbChecked : result:='checked';
     cbGrayed : result:='grayed';
   end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
   checkbox1.AllowGrayed:= not checkbox1.AllowGrayed;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
   if checkbox1.Checked=true then
     showmessage('checkbox1 = true')
   else
     showmessage('checkbox1 = false');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
   showmessage(showState(checkbox1.state));
end;

RadioButton
常放在Panel、RadioBox及GroupBox中，才能形成一組多選一的狀態


//先選擇一組內的所有Radio(shift選取)，然後選擇共同的事件
var
  blood : string;//blood為全域變數
procedure TForm1.RadioButton1Click(Sender: TObject);
var i: integer;
begin
  blood:=Tradiobutton(sender).Caption + '型';
end;
//最後確定的按鈕就為
procedure TForm1.Button2Click(Sender: TObject);
begin
  showmessage( blood + #10); //#10多加(自己亂加的)跳行意思
end;
//動態加入radiobuttoon於radiogoup中
procedure TForm1.Button1Click(Sender: TObject);
begin
  radiogroup1.Items.Add(edit1.Text);
end;
//將剛剛動態加入radiobuttoon清除
procedure TForm1.Button3Click(Sender: TObject);
begin
  radiogroup1.Items.clear;
end;
//將剛剛動態加入radiobuttoon清除
procedure TForm1.Button4Click(Sender: TObject);
begin
  radiogroup1.Columns:=2;
end;

ListBox


//單選，並得知ListBox1選哪一個
procedure TForm1.Button1Click(Sender: TObject);
begin
  listbox1.MultiSelect:=false;
showmessage(listbox1.Items[listbox1.ItemIndex]);
end;
//排序或不排序，一直做反向處理
procedure TForm1.Button3Click(Sender: TObject);
begin
  listbox1.Sorted:=not listbox1.Sorted;
end;
//加新的Item進去
procedure TForm1.aa1Click(Sender: TObject);
begin
  listbox1.AddItem(edit1.Text ,nil );
end;
//刪除Item
procedure TForm1.delete1Click(Sender: TObject);
begin
  listbox1.DeleteSelected;
end;
//顯示所有選到，這是可複選才要喔
procedure TForm1.showSelected1Click(Sender: TObject);
var 
  i: integer;
  s: string;
begin
  for i:= 0 to listbox1.Items.Count -1 do
  begin
    if listbox1.Selected[i] then
    s:= s + ' ' + listbox1.Items.Strings[i];
  end;

ComboBox
重要屬性
items
text
maxLength
dropDownCount
style
autocomplete
autodropdown//自動下拉到你要的


procedure TForm1.ComboBox1Click(Sender: TObject);
//加入一個新的Item
begin
  listbox1.Items.Add(combobox1.Text );
end;

星期四, 10月 04, 2007

輕鬆設定 hint 提示訊息

因為TMainMenu沒有ShowHint屬性，一般是顯示在StatusBar中

首先新增元件
TButton; 屬性Caption=Hint; 屬性Hint=提示!哈哈哈; 屬性ShowHint=True;
TMainMenu; (新增兩個按鈕喔N1及N2);
N1; 屬性Caption=檔案; 屬性Hint=檔案描述;
N2; 屬性Caption=開啟; 屬性Hint=開啟檔案;
TStatusBar;

事件：
TButton點兩下加入事件。


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    StatusBar1: TStatusBar;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure WhenHint(sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.HintPause := 100; //游標停留多久後顯示
  Application.HintHidePause := 5000; //顯示多久
  Application.HintShortPause := 5000; //若兩個元件有Hint(應該為重覆位置)，設定其間隔顯示時間
  Application.HintColor := clBlack; //hint背景色
  Screen.HintFont.Color := clWindow; //hint字型顏色
  //Screen.HintFont.Size := 12;  //修改字型大小

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnHint := WhenHint; //顯示Hint到StatusBar中
end;

procedure TForm1.WhenHint(sender: TObject);
begin  
  StatusBar1.SimpleText := Application.Hint;  
end;

end.

訂閱：文章 (Atom)

關於我自己

Archives

Subscribe

Powered By