Arsip: mengubah warna pada TbitButton
                
                   more 18 years ago
                  
              divanda
saya mau bertanya,, bagaimana caranya mengubah warna button pada TBitButton?
saya ingin memodifikasi tampilan form saya agar kelihatan menarik,, saya cari di propertinya tapi tidak menemukan bagaimana cara mengubah warna.. mohon bantuannya.. terimakasih..
*maaf pemula, banyak bertanya pertanyaan sepele..
                
                
                   more 18 years ago
                  
              p2bf
Saya lupa dapet dari mana...ini ada source..
                
unit ColorButton;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls;
type
  TDrawButtonEvent = procedure(Control: TWinControl;
    Rect: TRect; State: TOwnerDrawState) of object;
  TColorButton = class(TButton)
  private
    FCanvas: TCanvas;
    IsFocused: Boolean;
    FOnDrawButton: TDrawButtonEvent;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure DrawButton(Rect: TRect; State: UINT);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read FCanvas;
  published
    property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton;
    property Color;
  end;
procedure Register;
implementation
procedure Register;
begin
  RegisterComponents('Samples', [TColorButton]);
end;
constructor TColorButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TCanvas.Create;
end;
destructor TColorButton.Destroy;
begin
  inherited Destroy;
  FCanvas.Free;
end;
procedure TColorButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;
procedure TColorButton.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> IsFocused then
  begin
    IsFocused := ADefault;
    Refresh;
  end;
end;
procedure TColorButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth  := Width;
    itemHeight := Height;
  end;
end;
procedure TColorButton.CNDrawItem(var Message: TWMDrawItem);
var
  SaveIndex: Integer;
begin
  with Message.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    FCanvas.Lock;
    try
      FCanvas.Handle := hDC;
      FCanvas.Font := Font;
      FCanvas.Brush := Brush;
      DrawButton(rcItem, itemState);
    finally
      FCanvas.Handle := 0;
      FCanvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;
  end;
  Message.Result := 1;
end;
procedure TColorButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;
procedure TColorButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;
procedure TColorButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;
procedure TColorButton.DrawButton(Rect: TRect; State: UINT);
var
  Flags, OldMode: Longint;
  IsDown, IsDefault, IsDisabled: Boolean;
  OldColor: TColor;
  OrgRect: TRect;
begin
  OrgRect := Rect;
  Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
  IsDown := State and ODS_SELECTED <> 0;
  IsDefault := State and ODS_FOCUS <> 0;
  IsDisabled := State and ODS_DISABLED <> 0;
  if IsDown then Flags := Flags or DFCS_PUSHED;
  if IsDisabled then Flags := Flags or DFCS_INACTIVE;
  if IsFocused or IsDefault then
  begin
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Pen.Width := 1;
    FCanvas.Brush.Style := bsClear;
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
    InflateRect(Rect, - 1, - 1);
  end;
  if IsDown then
  begin
    FCanvas.Pen.Color := clBtnShadow;
    FCanvas.Pen.Width := 1;
    FCanvas.Brush.Color := clBtnFace;
    FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
    InflateRect(Rect, - 1, - 1);
  end
  else
    DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags);
  if IsDown then OffsetRect(Rect, 1, 1);
  OldColor := FCanvas.Brush.Color;
  FCanvas.Brush.Color := Color;
  FCanvas.FillRect(Rect);
  FCanvas.Brush.Color := OldColor;
  OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT);
  FCanvas.Font.Color := clBtnText;
  if IsDisabled then
    DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0,
    ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2,
    ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2,
      0, 0, DST_TEXT or DSS_DISABLED)
  else
    DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect,
      DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  SetBkMode(FCanvas.Handle, OldMode);
  if Assigned(FOnDrawButton) then
    FOnDrawButton(Self, Rect, TOwnerDrawState(LongRec(State).Lo));
  if IsFocused and IsDefault then
  begin
    Rect := OrgRect;
    InflateRect(Rect, - 4, - 4);
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Brush.Color := clBtnFace;
    DrawFocusRect(FCanvas.Handle, Rect);
  end;
end;
end.
moga bermanfaat... :wink:
                
                   more 18 years ago
                  
              juan81
aku gak senang ubah sourcenya aslinya dari delphi... kalo nanti tracing ikut2 itu source... ohohoh... aku juga pernah buat scroll di dbgrid di delphi 7... hohoho.... setiap kalo tracing masuk unit dbgrid.pas nya... malas....
kalo mau buat button isa warna ganti panel aja.. hohohoho....
                
                
                   more 18 years ago
                  
              divanda
trima kasih atas jawabannya.. wah tapi itu code nya banyak bener.. untuk pemula sungguh bener2 pusing..
                
                
                   more 18 years ago
                  
              xerion
bukannya banyak bener, masukkan sebagai salah satu komponen di IDE
jadi tinggal diletakkan pada form
atau kalau yang komponen yang lain bisa cari di torry, banyak loh ...
                more ...
              - Pages:
 - 1
 
                    
                     reply  |
                     Report Obsolete
                  
                AI Forward
            
🚀 We're thrilled to partner with Alibaba Cloud for "AI Forward - Alibaba Cloud Global Developer Summit 2025" in Jakarta! Join us and explore the future of AI. Register now: 
https://int.alibabacloud.com/m/1000400772/
#AlibabaCloud #DeveloperSummit #Jakarta #AIFORWARD
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 5 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 5 years ago - Archive
 - Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 13 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 13 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 13 years ago 
Random Topic
- Barcode
by anak_s0leh in Tip n Trik Pemrograman more 16 years ago - Download Automatis pada waktu yang sudah ditentukan
by belajaraja in Tip n Trik Pemrograman more 18 years ago - Preport
by ronixs in MySQL more 17 years ago - Password di MS Sql Server 2000
by d3n1bgt in MySQL more 15 years ago - report cuma bisa nongol 1x..puciii..ng
by asiyrob in MySQL more 18 years ago - OUT OF  MEMORY
by darsaneit in Tip n Trik Pemrograman more 14 years ago - import dari .txt ke mysql
by belajaraja in MySQL more 18 years ago - Pindah Record Dengan Scroll Mouse
by umarbakri in Hal umum tentang Pascal Indonesia more 19 years ago - About VCLSkin - Only For Penjahat
by cyber_hecker in OOT more 20 years ago - [help] mysql gagal insert
by binyo in MySQL more 13 years ago 
