請問可以在 TButton 元件上, 指定顯示圖檔 (.bmp or .jpg or GIF ) 嗎 ? 另外, 我若要在 K.Top 尋找相關議題, 該怎樣查詢比較好 ?

原創 hahalin 版主 修改版 kj68215 網友 http://delphi.ktop.com.tw/topic.php?topic_id=44074 http://delphi.ktop.com.tw/topic.php?topic_id=18859 搜索方式 http://delphi.ktop.com.tw/quicksearch.exe/quicksearch?searchstr=gif and TButton&page=2 有時靠記憶啦 哈哈

引言: 原創 hahalin 版主 修改版 kj68215 網友 http://delphi.ktop.com.tw/topic.php?topic_id=44074 http://delphi.ktop.com.tw/topic.php?topic_id=18859 搜索方式 http://delphi.ktop.com.tw/quicksearch.exe/quicksearch?searchstr=gif%2520and%2520TButton&page=2 有時靠記憶啦 哈哈

好利害 ! 我有download hahalin 版主的金剛版網咖 delphi , 有點深, 所以沒細看 修改版 kj68215 的是 BCB 版 第二個超連結,發問的是 : 如何改變 Button 的顏色, 裏面有 天使的範例, 我會下功夫看 , 3Q K.Top 資源真是豐富, 好多篇都值得研究(常讓我分心), 所以, 才請教是否有比較準確的方法, 可以搜尋出較精準的資料 或者 你知道 quicksearch.exe 的搜尋原理 非常感謝

为啥要用tbutton呢 tspeedbutton可以,可以文字,也可以图片

引言: 为啥要用tbutton呢 tspeedbutton可以,可以文字,也可以图片

因為, TSpeedButton 的 Glyph 好像只能用 .bmp 然後, 我是希望 圖.文 可以並呈, 但是, 圖可以指定顯示整個 Button , 或是指定 80% or 50% 我想, 可能沒有現成的, 所以, 只好自己動手了. 3Q ,

新手需知---本站使用說明 http://delphi.ktop.com.tw/ktop12.htm    7.如何尋找本站的元件資料庫? http://delphi.ktop.com.tw/topic.php?TOPIC_ID=18248     

引言: 如何尋找本站的元件資料庫? 1.請至"搜尋文章":http://delphi.ktop.com.tw/search_adv.asp 2.於尋找內容處輸入查尋元件的關鍵字,如:FAX 3.可再配合其它查詢關鍵字,如: (Source) -> 表有原始程式 (FreeWare) -> 表免費元件 (SwareWare) -> 表共享元件 (D1) -> 支援 Delphi 1.0 (D2) -> 支援 Delphi 2.0 (D3) -> 支援 Delphi 3.0 (D4) -> 支援 Delphi 4.0 (D5) -> 支援 Delphi 5.0 (D6) -> 支援 Delphi 6.0 (CB3) -> 支援 C Builder 3.0 (CB4) -> 支援 C Builder 4.0 (CB5) -> 支援 C Builder 5.0 (KLX1) -> 支援 KYLIX 1.0 (KLX2) -> 支援 KYLIX 2.0 例如:輸入:Fax (D5) (Freeware) (Source) (中間用空白格開) 代表:尋找所有的元件中有支援FAX的元件,且可在Delphi 5.0上使用,而且免費又有原始程式的元件 按尋找會找到:SFF (Structured Fax File) (V1.02 D3 D4 D5) 元件 ～～～Delphi K.Top討論區站長～～～

不是我知道 是新手應該先看遊戲規則 看似無用其實不然

進階搜尋已停用 取而代之的 [快速尋找] , 有沒有參考說明 ? 像是大小寫? 關鍵字 ? (Source) (D5) ... 感恩您啦 !

引言:進階搜尋已停用

已改版過 哈哈 忘記了 可以用空白隔開搜尋關鍵字!(採用AND搜尋)

引言:我有download hahalin 版主的金剛版網咖 delphi , 有點深, 所以沒細看

順便提一下 hahalin 版主的金剛版網咖 delphi 原生的技術是參考某 日本人的 有公開源始碼 但是就算公開的也不一定看得懂 此vcl作者應該是以前駐日的寶籃工程師 哈哈 你可以在google找看看 測試自己的對關鍵資料的嗅覺與搜索能力 發表人 - conundrum 於 2005/07/31 11:07:56

慘啦 ! 我的最終目標就像是 網咖金剛版耶 ! 感謝 conundrum 大大的指導: 經過幾天的搜尋測試, 了解到 , 其實我目前這個問題, 可以這樣解決 : 1. 用一個 Panel , 放一個TButton , 再放一個 TImage 2. 加一個 property , 讓 Button 可以有顏色即可 3. 加一個 property , 可以指定 Image 與 Button 所佔用Panel的比例 4. 加一個 property , 可以指定 Image 與 Button 的相對位置, Left, Right, Top , Button 可以這樣 兜出自己要用的元件嗎 ? 或者像我原來的想法 : 1. 繼承一個 TButton 2. 加一個 property , 放 Image 指定的檔名 3. 加一個 property , 放 Image 的位置 , left, right, top, button 4. 查看 Timage 的原始碼,看是如何讀圖檔? loadfile... 如何顯示? canvas ... 請教, 哪一種作法比較正確 ?

cwc65536 網友你好    在ktop呆久一點的可能都知道 庵的原則 1 沒有決對答案的答題 2 看不慣的k下去 3 永遠看不到庵的程式碼 4 最會2招就是 這個不會那個也不會啦     第一項 天馬行空實驗 VS 理論 等於=不等於 第二項 應該不用解釋啦 第三項 卡有趣 因為庵不會寫程式 哈哈 第四項 應該不用解釋啦    在好友hahalin 版主的面前 庵是不敢耍嘴皮子的 因為他開車比庵快 大刀砍下去 庵的 摩托塞垢50cc 就完啦 金剛版網咖的技術問題應該另外

引言: 1. 用一個 Panel , 放一個TButton , 再放一個 TImage

我想 Panel TImage ini就夠了 猜的啦 試看看 Panel可以4*4而TImage一樣4*4 ini喔1個或搭配access 哈哈 台灣災難都是事後算帳 無人飛行載具(Unmanned Aerial Vehicle，UAV)為什麼沒大量應用於救災行列

引言:

引言: 1. 用一個 Panel , 放一個TButton , 再放一個 TImage

我想 Panel TImage ini就夠了 猜的啦 試看看 Panel可以4*4而TImage一樣4*4 ini喔1個或搭配access 哈哈 台灣災難都是事後算帳 無人飛行載具(Unmanned Aerial Vehicle，UAV)為什麼沒大量應用於救災行列

嘿 ! 不是只用一次耶 ! 這可是兜成一個元件, 要在設計階段就能有視覺效果, 對我這個初學者, 可是大挑戰 ! conundrum 兄 : 無人飛行載具, 好玩 ! 但是很難耶 ! 光是玩具遙控飛機(直昇機)都很難控制, 何況長程遙控 !

無人機具 市庵新的簽名檔啦 無人飛行載具, 好玩 ! 但是很難耶 ! 光是玩具遙控飛機(直昇機)都很難控制, 何況長程遙控 在隧道者篇 有連結 應用部份與搭配的硬體 gsm gps都是無問題的 http://delphi.ktop.com.tw/topic.php?TOPIC_ID=75946 麻園頭溪空拍片段 此影片為DV壓縮影片，解析度較差 http://infi.com.tw/Dv1.wmv 內含數據資料、日期、時間、GPS座標、高度、速度及方向。 GPS衛星定位追蹤器 http://infi.com.tw/gpspro.asp 嘿 ! 不是只用一次耶 ! 這可是兜成一個元件, 要在設計階段就能有視覺效果, 對我這個初學者, 可是大挑戰 ! 庵的觀念 不須兜成元件 只要搭配引用 在除錯上是比較麻煩 但是你如果找的到庵說的類似vcl將更ez上手 基本上庵說的那vcl是開放的 新手是說 KTOP的使用方式 庵不認為你是程式新手 哈哈 台灣災難都是事後算帳 無人飛行載具(Unmanned Aerial Vehicle，UAV)為什麼沒大量應用於救災行列 發表人 - conundrum 於 2005/08/02 00:41:34

conundrum 兄, 又被你難倒了. 怎樣找到那個 [類似VCL] ? < > 透漏一下嘛 ! 另外, 那段空拍是你作的嗎 ? 還蠻清楚穩定的 ! 配備如何 ? 本來也想玩的, 可是很花錢, 而且, 一直以為效果很差 .< >

cwc65536 兄 你好 說真ㄟ 庵目前的電腦已經沒有delphi這東西啦 所以真正忘記那vcl的名字 不過你可以至以前寶籃的深渡論壇找看看 因為那是寶籃以前 傻破 的論壇 我不知道是否還有放在那 那空拍不是庵拍的啦 是販賣無人機具的台灣廠商拍的 之前還有看到 使用這小東西利用於 無人倉儲 介紹的這台的優點 > > > 台灣災難都是事後算帳 無人飛行載具(

插花一下！ 自己寫一個並不會很難。TSpeedButton 算是很接近了。 Margin 及spacing屬性用來調節圖文位置。 可依樣畫葫蘆 將 TBitmap 改用 TPicture 處理一下 就可以了。 或者到Torry's 找找吧！ 這種元件常常看到。 ～～～～～～～～～～～ 難得聰明，常常糊塗。 ～～～～～～～～～～～

conundrum 兄, 你好 有個 Delphi 深度歷險, 紅極一時, but 上面蠻多蜘蛛網, 不過, 我還是進去挖了幾個回來試試, 容後再報告戰果 ! ? 能定點盤旋拍攝 and 不用加油 => 就是電動直昇機囉 ! 之前想玩的時候在河邊看人家玩, 保麗龍機身的小飛機, 摔得蠻慘 直昇機可能好一點, 6000.- 直昇機 , where to buy ? GPS 可能不需要, 想不到要拿來幹嘛 ! (成立 救難小英雄) 攝影機, 有需要 (想想,都好興奮)

wameng 真好真好 如果是庵 會搭配LMD的vcl來處理 因為這樣寫卡簡單 繪圖的元件他都幫你寫了 LMD 於6.0之後就要口口了    cwc65536 問到 where to buy  庵不是有po了 http://infi.com.tw/ E-SKY系列電動直昇機 http://infi.com.tw/esky/honey3D.htm 易承開發科技有限公司 INFINITY TECHNOLOGY CO., LTD. 台中市南區建國南路一段247號 Tel:04-22650977 Fax:04-22650978 台灣災難都是事後算帳 無人飛行載具(Unmanned Aerial Vehicle，UAV)為什麼沒大量應用於救災行列 發表人 - conundrum 於 2005/08/02 13:24:29

引言: 插花一下！ 自己寫一個並不會很難。TSpeedButton 算是很接近了。 Margin 及spacing屬性用來調節圖文位置。 可依樣畫葫蘆 將 TBitmap 改用 TPicture 處理一下 就可以了。 或者到Torry's 找找吧！ 這種元件常常看到。 ～～～～～～～～～～～ 難得聰明，常常糊塗。 ～～～～～～～～～～～

wameng 兄您好: Torry's 說他 HD 掛了 ! 請教如何將 TSpeedButton 的 TBitMap 換成 TPicture ? 是另作一個元件,以 TSpeedButton 為基礎 class , 再加上 TPicture property 嗎 ? 我的問題也在這裏, 怎樣畫出 picture ? 我該去 study Delphi 的 Source code 嗎 ? Delphi 的 buttons.pas 把所有 Button 都放一起, 讓我看得 [霧煞煞] ! 還請指引正確的道路, 感恩 !

由於最近有點麻煩事，所以就耽擱了回復您。    我臨時改寫TSpeedButton 的Glyph 改為 TPicture. 有點雜亂。做參考就好了。(沒有花很多時間注意細節)

Type
  TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
  TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive);      TPicBtn = class(TGraphicControl)
  private
    FGroupIndex: Integer;
    FGlyph: TPicture;
    FDown: Boolean;
    FDragging: Boolean;
    FAllowAllUp: Boolean;
    FLayout: TButtonLayout;
    FSpacing: Integer;
    FTransparent: Boolean;
    FMargin: Integer;
    FFlat: Boolean;
    FMouseInControl: Boolean;
    procedure UpdateExclusive;
    procedure SetGlyph(Value: TPicture);
    procedure SetDown(Value: Boolean);
    procedure SetFlat(Value: Boolean);
    procedure SetAllowAllUp(Value: Boolean);
    procedure SetGroupIndex(Value: Integer);
    procedure SetLayout(Value: TButtonLayout);
    procedure SetSpacing(Value: Integer);
    procedure SetTransparent(Value: Boolean);
    procedure SetMargin(Value: Integer);
    procedure UpdateTracking;
    procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    FState: TButtonState;
    procedure Loaded; 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;
    procedure Paint; override;
    property MouseInControl: Boolean read FMouseInControl;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
  published
    property Action;
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property Down: Boolean read FDown write SetDown default False;
    property Caption;
    property Enabled;
    property Flat: Boolean read FFlat write SetFlat default False;
    property Font;
    property Glyph: TPicture read fGlyph write SetGlyph;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property ParentFont;
    property ParentShowHint;
    property ParentBiDiMode;
    property PopupMenu;
    property ShowHint;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Transparent: Boolean read FTransparent write SetTransparent default True;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;        { TPicBtn }    constructor TPicBtn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FGlyph := TPicture.Create;      SetBounds(0, 0, 23, 22);
  ControlStyle := [csCaptureMouse, csDoubleClicks];
  ParentFont := True;
  Color := clBtnFace;
  FSpacing := 4;
  FMargin := -1;
  FLayout := blGlyphLeft;
  FTransparent := True;
end;    destructor TPicBtn.Destroy;
begin
  FGlyph.Free;
  inherited Destroy;
end;    procedure TPicBtn.Paint;
  { TButtonGlyph 繪圖的部分 }
  procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
    TextBounds: TRect; State: TButtonState; BiDiFlags: LongInt);
  begin
    with Canvas do
    begin
      Brush.Style := bsClear;
      if State = bsDisabled then
      begin
        OffsetRect(TextBounds, 1, 1);
        Font.Color := clBtnHighlight;
        DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
          DT_CENTER or DT_VCENTER or BiDiFlags);
        OffsetRect(TextBounds, -1, -1);
        Font.Color := clBtnShadow;
        DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
          DT_CENTER or DT_VCENTER or BiDiFlags);
      end else
        DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
          DT_CENTER or DT_VCENTER or BiDiFlags);
    end;
  end;      procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
    const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin,
    Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
    BiDiFlags: LongInt);
  var
    TextPos: TPoint;
    ClientSize, GlyphSize, TextSize: TPoint;
    TotalSize: TPoint;
  begin
    if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
      if Layout = blGlyphLeft then Layout := blGlyphRight
      else 
        if Layout = blGlyphRight then Layout := blGlyphLeft;
    { calculate the item sizes }
    ClientSize := Point(Client.Right - Client.Left, Client.Bottom -
      Client.Top);        if (FGlyph.Graphic<>Nil) and (Not FGlyph.Graphic.Empty)
       then GlyphSize := Point(FGlyph.Width,FGlyph.Height)
       else GlyphSize := Point(0, 0);
    
    if Length(Caption) > 0 then
    begin
      TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
      DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds,
        DT_CALCRECT or BiDiFlags);
      TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
        TextBounds.Top);
    end
    else
    begin
      TextBounds := Rect(0, 0, 0, 0);
      TextSize := Point(0,0);
    end;
    
    { If the layout has the glyph on the right or the left, then both the
      text and the glyph are centered vertically.  If the glyph is on the top
      or the bottom, then both the text and the glyph are centered horizontally.}
    if Layout in [blGlyphLeft, blGlyphRight] then
    begin
      GlyphPos.Y := (ClientSize.Y - GlyphSize.Y   1) div 2;
      TextPos.Y := (ClientSize.Y - TextSize.Y   1) div 2;
    end
    else
    begin
      GlyphPos.X := (ClientSize.X - GlyphSize.X   1) div 2;
      TextPos.X := (ClientSize.X - TextSize.X   1) div 2;
    end;
    
    { if there is no text or no bitmap, then Spacing is irrelevant }
    if (TextSize.X = 0) or (GlyphSize.X = 0) then
      Spacing := 0;
    
    { adjust Margin and Spacing }
    if Margin = -1 then
    begin
      if Spacing = -1 then
      begin
        TotalSize := Point(GlyphSize.X   TextSize.X, GlyphSize.Y   TextSize.Y);
        if Layout in [blGlyphLeft, blGlyphRight] then
          Margin := (ClientSize.X - TotalSize.X) div 3
        else
          Margin := (ClientSize.Y - TotalSize.Y) div 3;
        Spacing := Margin;
      end
      else
      begin
        TotalSize := Point(GlyphSize.X   Spacing   TextSize.X, GlyphSize.Y  
          Spacing   TextSize.Y);
        if Layout in [blGlyphLeft, blGlyphRight] then
          Margin := (ClientSize.X - TotalSize.X   1) div 2
        else
          Margin := (ClientSize.Y - TotalSize.Y   1) div 2;
      end;
    end
    else
    begin
      if Spacing = -1 then
      begin
        TotalSize := Point(ClientSize.X - (Margin   GlyphSize.X), ClientSize.Y -
          (Margin   GlyphSize.Y));
        if Layout in [blGlyphLeft, blGlyphRight] then
          Spacing := (TotalSize.X - TextSize.X) div 2
        else
          Spacing := (TotalSize.Y - TextSize.Y) div 2;
      end;
    end;
    
    case Layout of
      blGlyphLeft:
        begin
          GlyphPos.X := Margin;
          TextPos.X := GlyphPos.X   GlyphSize.X   Spacing;
        end;
      blGlyphRight:
        begin
          GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
          TextPos.X := GlyphPos.X - Spacing - TextSize.X;
        end;
      blGlyphTop:
        begin
          GlyphPos.Y := Margin;
          TextPos.Y := GlyphPos.Y   GlyphSize.Y   Spacing;
        end;
      blGlyphBottom:
        begin
          GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
          TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
        end;
    end;
    
    { fixup the result variables }
    with GlyphPos do
    begin
      Inc(X, Client.Left   Offset.X);
      Inc(Y, Client.Top   Offset.Y);
    end;
    OffsetRect(TextBounds, TextPos.X   Client.Left   Offset.X,
      TextPos.Y   Client.Top   Offset.X);
  end;      function Draw(Canvas: TCanvas; const Client: TRect;
    const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
    Margin, Spacing: Integer; State: TButtonState; Transparent: Boolean;
    BiDiFlags: LongInt): TRect;
  var
    GlyphPos: TPoint;
  begin
    CalcButtonLayout(Canvas, Client, Offset, Caption, Layout, Margin, Spacing,
      GlyphPos, Result, BiDiFlags);        if (FGlyph.Graphic<>Nil) and (Not FGlyph.Graphic.Empty)
       then Canvas.Draw(GlyphPos.X,GlyphPos.Y,FGlyph.Graphic);
    DrawButtonText(Canvas, Caption, Result, State, BiDiFlags);
  end;
const
  DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
var
  PaintRect: TRect;
  DrawFlags: Integer;
  Offset: TPoint;
begin
  if not Enabled then
  begin
    FState := bsDisabled;
    FDragging := False;
  end
  else if FState = bsDisabled then
    if FDown and (GroupIndex <> 0) then
      FState := bsExclusive
    else
      FState := bsUp;
  Canvas.Font := Self.Font;
  PaintRect := Rect(0, 0, Width, Height);
  if not FFlat then
  begin
    DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
    if FState in [bsDown, bsExclusive] then
      DrawFlags := DrawFlags or DFCS_PUSHED;
    DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
  end
  else
  begin
    if (FState in [bsDown, bsExclusive]) or
      (FMouseInControl and (FState <> bsDisabled)) or
      (csDesigning in ComponentState) then
      DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
        FillStyles[Transparent] or BF_RECT)
    else if not Transparent then
    begin
      Canvas.Brush.Color := Color;
      Canvas.FillRect(PaintRect);
    end;
    InflateRect(PaintRect, -1, -1);
  end;
  if FState in [bsDown, bsExclusive] then
  begin
    if (FState = bsExclusive) and (not FFlat or not FMouseInControl) then
    begin
      Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
      Canvas.FillRect(PaintRect);
    end;
    Offset.X := 1;
    Offset.Y := 1;
  end
  else
  begin
    Offset.X := 0;
    Offset.Y := 0;
  end;      Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin,
    FSpacing, FState, Transparent, DrawTextBiDiModeFlags(0));
end;
    
procedure TPicBtn.UpdateTracking;
var
  P: TPoint;
begin
  if FFlat then
  begin
    if Enabled then
    begin
      GetCursorPos(P);
      FMouseInControl := not (FindDragTarget(P, True) = Self);
      if FMouseInControl then
        Perform(CM_MOUSELEAVE, 0, 0)
      else
        Perform(CM_MOUSEENTER, 0, 0);
    end;
  end;
end;
    
procedure TPicBtn.Loaded;
var
  State: TButtonState;
begin
  inherited Loaded;
  if Enabled then
    State := bsUp
  else
    State := bsDisabled;
end;
    
procedure TPicBtn.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then
  begin
    if not FDown then
    begin
      FState := bsDown;
      Invalidate;
    end;
    FDragging := True;
  end;
end;
    
procedure TPicBtn.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewState: TButtonState;
begin
  inherited MouseMove(Shift, X, Y);
  if FDragging then
  begin
    if not FDown then NewState := bsUp
    else NewState := bsExclusive;
    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
      if FDown then NewState := bsExclusive else NewState := bsDown;
    if NewState <> FState then
    begin
      FState := NewState;
      Invalidate;
    end;
  end
  else if not FMouseInControl then
    UpdateTracking;
end;    procedure TPicBtn.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then
  begin
    FDragging := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    if FGroupIndex = 0 then
    begin
      { Redraw face in-case mouse is captured }
      FState := bsUp;
      FMouseInControl := False;
      if DoClick and not (FState in [bsExclusive, bsDown]) then
        Invalidate;
    end
    else
      if DoClick then
      begin
        SetDown(not FDown);
        if FDown then Repaint;
      end
      else
      begin
        if FDown then FState := bsExclusive;
        Repaint;
      end;
    if DoClick then Click;
    UpdateTracking;
  end;
end;
    
procedure TPicBtn.Click;
begin
  inherited Click;
end;
    
procedure TPicBtn.SetGlyph(Value: TPicture);
begin
  FGlyph.Assign(Value);
  Invalidate;
end;
    
procedure TPicBtn.UpdateExclusive;
var
  Msg: TMessage;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_BUTTONPRESSED;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;    procedure TPicBtn.SetDown(Value: Boolean);
begin
  if FGroupIndex = 0 then Value := False;
  if Value <> FDown then
  begin
    if FDown and (not FAllowAllUp) then Exit;
    FDown := Value;
    if Value then
    begin
      if FState = bsUp then Invalidate;
      FState := bsExclusive
    end
    else
    begin
      FState := bsUp;
      Repaint;
    end;
    if Value then UpdateExclusive;
  end;
end;
    
procedure TPicBtn.SetFlat(Value: Boolean);
begin
  if Value <> FFlat then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;
    
procedure TPicBtn.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;
    
procedure TPicBtn.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;
    
procedure TPicBtn.SetMargin(Value: Integer);
begin
  if (Value <> FMargin) and (Value >= -1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;
    
procedure TPicBtn.SetSpacing(Value: Integer);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;    procedure TPicBtn.SetTransparent(Value: Boolean);
begin
  if Value <> FTransparent then
  begin
    FTransparent := Value;
    if Value then
      ControlStyle := ControlStyle - [csOpaque] else
      ControlStyle := ControlStyle   [csOpaque];
    Invalidate;
  end;
end;    procedure TPicBtn.SetAllowAllUp(Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;
    
procedure TPicBtn.WMLButtonDblClk(var Message: TWMLButtonDown);
begin
  inherited;
  if FDown then DblClick;
end;
    
procedure TPicBtn.CMEnabledChanged(var Message: TMessage);
begin
  UpdateTracking;
  Repaint;
end;    procedure TPicBtn.CMButtonPressed(var Message: TMessage);
var
  Sender: TPicBtn;
begin
  if Message.WParam = FGroupIndex then
  begin
    Sender := TPicBtn(Message.LParam);
    if Sender <> Self then
    begin
      if Sender.Down and FDown then
      begin
        FDown := False;
        FState := bsUp;
        Invalidate;
      end;
      FAllowAllUp := Sender.AllowAllUp;
    end;
  end;
end;
    
procedure TPicBtn.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled and Visible and
      (Parent <> nil) and Parent.Showing then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;
    
procedure TPicBtn.CMFontChanged(var Message: TMessage);
begin
  Invalidate;
end;
    
procedure TPicBtn.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;    procedure TPicBtn.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  { Don't draw a border if DragMode <> dmAutomatic since this button is meant to 
    be used as a dock client. }
  if FFlat and not FMouseInControl and Enabled and (DragMode <> dmAutomatic)
    and (GetCapture = 0) then
  begin
    FMouseInControl := True;
    Repaint;
  end;
end;    procedure TPicBtn.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if FFlat and FMouseInControl and Enabled and not FDragging then
  begin
    FMouseInControl := False;
    Invalidate;
  end;
end;

當然別忘了加上 Procedure Register; procedure Register; begin RegisterComponents('samples', [TPicBtn]); end; ～～～～～～～～～～～ 難得聰明，常常糊塗。 ～～～～～～～～～～～

wameng 兄, 我真不知該如何表達我的感覺 , 有點想哭 ! 居然 po 這麼完整的程式碼, 一定花您不少的時間 ! 1. 這些是從delphi VCL 原始碼 buttons.pas 中,關於 TSpeedBtn 的部份,節錄出來,然後修改 Glyph -> Picture 的嗎 ? 否則,我會很愧疚. 2. 我很笨,花了比較多的時間才能用,所以現在才回應, Sorry ! 後續需求如下,我會努力看看 : picture 有 Stretch 的屬性 picture 佔 Button的版面, 可控制 0 - 100% 文字放在剩餘版面的正中間, 有 Swap 屬性可選 Button 有底色屬性可選, 主要是給 Font 文字用 .... 大功告成 因為 PicBtn 還在修改階段,為方便 Debug , 是否可以先不要放進 Component 中 ? 那我怎樣讓測試程式可以引用 PicBtn 元件 ?

引言: wameng 兄, 我真不知該如何表達我的感覺 , 有點想哭 ! 居然 po 這麼完整的程式碼, 一定花您不少的時間 ! 1. 這些是從delphi VCL 原始碼 buttons.pas 中,關於 TSpeedBtn 的部份,節錄出來,然後修改 Glyph -> Picture 的嗎 ? 否則,我會很愧疚. 2. 我很笨,花了比較多的時間才能用,所以現在才回應, Sorry ! 後續需求如下,我會努力看看 : picture 有 Stretch 的屬性 picture 占 Button的版面, 可控制 0 - 100% 文字放在剩餘版面的正中間, 有 Swap 屬性可選 Button 有底色屬性可選, 主要是給 Font 文字用 .... 大功告成 因為 PicBtn 還在修改階段,為方便 Debug , 是否可以先不要放進 Component 中 ? 那我怎樣讓測試程式可以引用 PicBtn 元件 ?

ㄟ... 那你就哭吧！ 男人 哭吧～哭吧....不是罪...(劉德華的歌) 開玩笑的。.. 嗯！..節錄出來,然後修改 > class="code"> TPicBtn = ... .... procedure TForm1.FormCreate(Sender: TObject); var fPicBtn :TPicBtn; begin fPicBtn :=TPicBtn.Create(Self); fPicBtn.Parent := Self; fPicBtn.Caption := '13213213 3213213'; fPicBtn.Glyph.LoadFromFile('c:\123.ico'); fPicBtn.Margin := -1; fPicBtn.SetBounds(20,20,100,100); fPicBtn.Layout := blGlyphTop; end; ～～～～～～～～～～～ 難得聰明，常常糊塗。 ～～～～～～～～～～～