ایجاد tile در devexpress کامپوننت دلفی

  و  ایجاد کاشی در زمان اجرا devexpress کامپوننت دلفی 

و ایجاد کد رنگ رندوم

procedure TDesktopDemoMainForm.Button1Click(Sender: TObject);

var AItem: TdxTileControlItem;

    sizeItem:integer;

begin

   AItem:= dxTileControl1.items.add;

   with AItem do

   begin

     IsLarge := True;

     AItem.Name:='a'+inttostr(random(4000));

     AItem.Text1.value:='test';

     sizeItem:=random(4)  ;

     case  sizeItem   of

   //  1:AItem.Size:=tcisSmall;

     1:AItem.Size:=tcisLarge;

     2:AItem.Size:=tcisRegular;

     3:AItem.Size:=tcisLarge;

     4: AItem.Size:=tcisExtraLarge;

     end;

     text1.font.Size:=12;

     glyph.ImageIndex:=random(9)  ;

     group:=dxTileControl1Group1;

     style.GradientBeginColor:=GenerateRandomColor;

   end;

end;

function GenerateRandomColor(const Mix: TColor = clWhite): TColor;
var
  Red, Green, Blue: Integer;
begin
  Red := Random(256);      
  Green := Random(256);
  Blue := Random(256);

  Red := (Red + GetRValue(ColorToRGB(Mix))) div 2;      
  Green := (Green + GetGValue(ColorToRGB(Mix))) div 2;
  Blue := (Blue + GetBValue(ColorToRGB(Mix))) div 2;
  Result := RGB(Red, Green, Blue);
end;

Delphi/Lazarus: Round Decimal Numbers up, down and normally

• Round: normal, convergent rounding (Banker's Rule)
• Trunc: crops decimal places (=rounding down)
• Ceil: rounding up (contained in Math)
• Floor: rounding down (contained in Math)
• Int: makes an integer value from a decimal number (=rounding down)
• Frac: crops all before the decimal places/replaces the integer part of the number with 0

Delphi custom TTreeNode

برای داشتن ایتم های اضافی در درخت دلفی  میتوان با نوشتن کد زیر ان را شخصی سازی کرد 

type
  TCustomTreeNode = class(TTreeNode)
  protected
    procedure Assign(Source: TPersistent); override;
  public
    Comment: string;
  end;

procedure TCustomTreeNode.Assign(Source: TPersistent);
begin
  if Source is TCustomTreeNode then
    Comment := TCustomTreeNode(Source).Comment;
  inherited;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  NewNode: TCustomTreeNode;
begin
  NewNode := TreeView1.Items.Add(nil, 'Node1') as TCustomTreeNode;
  NewNode.Comment := 'A comment';
  NewNode := TreeView1.Items.Add(nil, 'Node2') as TCustomTreeNode;
  NewNode.Comment := 'Another comment';
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  Node: TCustomTreeNode;
begin
  Node := TreeView1.Selected as TCustomTreeNode;
  if Assigned(Node) then
    ShowMessage(Node.Comment);
end;

procedure TForm1.TreeView1CreateNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass);
begin
  NodeClass := TCustomTreeNode;
end;

نمایش دیتل در کنار هدر در کنارهم در sql server

برای اینکه جزییات یا ردیف های جدول دیتیل به صورت ستون در جدول هدر نمایش داده شوند از کد زیر به عنوان نمونه میتوانید استفاده کنید 

CREATE PROCEDURE OrderExample 

AS

CREATE TABLE #OrdersTable(

OrderNo int,

OrderDate date,

CustomerID int,

TotalItems int,

TotalAmount decimal(10,2)

)

INSERT INTO #OrdersTable VALUES(101, '2016-8-11', 354, 3, 30)

INSERT INTO #OrdersTable VALUES(102, '2016-8-12', 221, 2, 20)

INSERT INTO #OrdersTable VALUES(103, '2016-8-13', 67, 1, 20)

INSERT INTO #OrdersTable VALUES(104, '2016-8-14', 8965, 3, 40)

CREATE table #OrderedItems (

OrderNo int,

OrderItem varchar(10),

OrderQty int

)

INSERT INTO #OrderedItems VALUES(101, 'T-Shirt', 2)

INSERT INTO #OrderedItems VALUES(101, 'Bedsheet', 1)

INSERT INTO #OrderedItems VALUES(102, 'Pants', 2)

INSERT INTO #OrderedItems VALUES(103, 'Quilt', 1)

INSERT INTO #OrderedItems VALUES(104, 'T-Shirt', 2)

INSERT INTO #OrderedItems VALUES(104, 'Pants', 1)

DECLARE @itemNames varchar(max) = 

(SELECT  STUFF(( SELECT DISTINCT ',' + QUOTENAME(OrderItem)

FROM #OrderedItems FOR XML PATH('')), 1, 1, '') AS ColList)

DECLARE @sql varchar(max) = 'SELECT OrderNo, OrderDate, CustomerID, 

TotalItems, TotalAmount,' + @itemNames + ' FROM

(SELECT o.OrderNo, o.OrderDate, o.CustomerID, o.TotalItems, o.TotalAmount,

i.OrderItem, i.OrderQty 

FROM #OrdersTable o

INNER JOIN #OrderedItems i ON i.OrderNo = o.OrderNo) SubQ

PIVOT(SUM(OrderQty) FOR OrderItem IN (' + @itemNames + ')) as pvt'

exec (@sql)

DROP TABLE #OrdersTable

DROP TABLE #OrderedItems

غیرفعال کردن چک کلید خارجی در mysql

اگر در زمان truncate جدول با خطای زیر مواجه شدید 

.....Error Code: 1833. Cannot change column '....': used in a foreign key constraint 

برای رفع این خطا میتوانید چک کردن کلید غیرفعال کنید و بعد از اتمام کار فعال کنید

SET FOREIGN_KEY_CHECKS = 0;
SET GLOBAL FOREIGN_KEY_CHECKS=0;

/* DO WHAT YOU NEED HERE */

SET FOREIGN_KEY_CHECKS = 1;
SET GLOBAL FOREIGN_KEY_CHECKS=1;

پیدا کردن ایندکس های بدون استفاده یا Unused Index

ایندکسی که مورد استفاده قرار نمی گیرد دارای هزینه نگهداری اند.

با اجرای دستور زیر ایندکس های اضافه در دیتابیس خودتون میتونید پیدا کنید و دستور حذف هم در اخر هر کدام برای راحتی کار شما قرار داده شده است .

توجه: اگر برای آزمایش کوئری پایین ، یک ایندکس را در همین لحظه تعریف کردید و سپس کوئری را روی پایگاه داده بلافاصله اجرا نمودید، به شما جواب نخواهد داد، برای بدست آوردن نتیجه ی مناسب، نیاز به زمان و ورود و خروج اطلاعات دارید.

SELECT TOP 100

o.name AS ObjectName

, i.name AS IndexName

, i.index_id AS IndexID

, dm_ius.user_seeks AS UserSeek

, dm_ius.user_scans AS UserScans

, dm_ius.user_lookups AS UserLookups

, dm_ius.user_updates AS UserUpdates

, p.TableRows

, 'DROP INDEX ' + QUOTENAME(i.name)

+ ' ON ' + QUOTENAME(s.name) + '.' + QUOTENAME(OBJECT_NAME(dm_ius.OBJECT_ID)) AS 'drop statement'

FROM sys.dm_db_index_usage_stats dm_ius

INNER JOIN sys.indexes i ON i.index_id = dm_ius.index_id AND dm_ius.OBJECT_ID = i.OBJECT_ID

INNER JOIN sys.objects o ON dm_ius.OBJECT_ID = o.OBJECT_ID

INNER JOIN sys.schemas s ON o.schema_id = s.schema_id

INNER JOIN (SELECT SUM(p.rows) TableRows, p.index_id, p.OBJECT_ID

FROM sys.partitions p GROUP BY p.index_id, p.OBJECT_ID) p

ON p.index_id = dm_ius.index_id AND dm_ius.OBJECT_ID = p.OBJECT_ID

WHERE OBJECTPROPERTY(dm_ius.OBJECT_ID,'IsUserTable') = 1

AND dm_ius.database_id = DB_ID()

AND i.type_desc = 'nonclustered'

AND i.is_primary_key = 0

AND i.is_unique_constraint = 0

ORDER BY (dm_ius.user_seeks + dm_ius.user_scans + dm_ius.user_lookups) ASC

GO

نمایش تعداد رکوردهای کل جداول در دیتابیس sql

برای نمایش تعداد رکوردهای کل جداول در دیتابیس sql  میتوانید از دستور زیر استفاده نمایید 

SELECT SCHEMA_NAME(t.[schema_id]) AS [table_schema]
          ,OBJECT_NAME(p.[object_id]) AS [table_name]
          ,SUM(p.[rows]) AS [row_count]
    FROM [sys].[partitions] p
    INNER JOIN [sys].[tables] t ON p.[object_id] = t.[object_id]
    WHERE p.[index_id] < 2
    GROUP BY p.[object_id]
        ,t.[schema_id]
    ORDER BY 1, 2 ASC

کم کردن حجم خروجی فایل exe دلفی

کم کردن حجم  خروجی فایل exe دلفی در ورژن های دلفی بالا xe 5 :
Project-->Option-->Delphi Compiler-->Linking-->Debug Information
این تیک اگر true هست false کنید بعد کامپایل بگیرید حجم برنامه تقریبا نصف میشه
این تیک چیز مهمی نیست فقط راهنماهای دلفی درون برنامه میگذاره که تاثیری در برنامه نداره

پارس کردن ارایه جیسون در دلفی

برای پارس کردن ارایه در دلفی که نام ندارد از روش زیر میشود استفاده کرد 

program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
  System.SysUtils, dbxjson;
const JSON_DATA = '{"ArrayData":['+
                    '{"DAT_INCL":"07/03/2012 17:33:03", "NUM_ORDE":1,"NUM_ATND":1, "NUM_ACAO":2, "NUM_RESU":3},'+
                    '{"DAT_INCL":"07/03/2012 17:33:05", "NUM_ORDE":2,"NUM_ATND":1, "NUM_ACAO":4, "NUM_RESU":5},'+
                    '{"DAT_INCL":"07/03/2012 17:33:05", "NUM_ORDE":3,"NUM_ATND":1, "NUM_ACAO":8, "NUM_RESU":null}'+
                   ']}';
var jsv   : TJsonValue;
    originalObject : TJsonObject;
    jsPair : TJsonPair;
    jsArr : TJsonArray;
    jso  : TJsonObject;
    i : integer;
begin
    try
        //parse json string
        jsv := TJSONObject.ParseJSONValue(JSON_DATA);
        try
            //value as object
            originalObject := jsv as TJsonObject;
            //get pair, wich contains Array of objects
            jspair := originalObject.Get('ArrayData');
            //pair value as array
            jsArr := jsPair.jsonValue as  TJsonArray;
            writeln('array size: ', jsArr.Size);
            //enumerate objects in array
            for i := 0 to jsArr.Size - 1 do begin
                writeln('element ', i);
                // i-th object
                jso := jsArr.Get(i) as TJsonObject;
                //enumerate object fields
                for jsPair in jso do begin
                    writeln('   ', jsPair.JsonString.Value, ': ', jsPair.JsonValue.Value);
                end;
            end;
        finally
            jsv.Free();
            readln;
        end;
    except
        on E: Exception do
          Writeln(E.ClassName, ': ', E.Message);
    end;
end.

تاریخ شروع و پایان هفته در sql server

برای به دست اوردن هفته میلادی از توابع زیر میتونید استفاده کنید و برای پیدا کردن هفته شمسی یک روز از این تاریخ کم کنید

SELECT DATEADD(wk, -1, DATEADD(DAY, 1-DATEPART(WEEKDAY, GETDATE()), DATEDIFF(dd, 0, GETDATE()))) --first day previous week

SELECT DATEADD(wk, 0, DATEADD(DAY, 1-DATEPART(WEEKDAY, GETDATE()), DATEDIFF(dd, 0, GETDATE()))) --first day current week

SELECT DATEADD(wk, 1, DATEADD(DAY, 1-DATEPART(WEEKDAY, GETDATE()), DATEDIFF(dd, 0, GETDATE()))) --first day next week

SELECT DATEADD(wk, 0, DATEADD(DAY, 0-DATEPART(WEEKDAY, GETDATE()), DATEDIFF(dd, 0, GETDATE()))) --last day previous week

SELECT DATEADD(wk, 1, DATEADD(DAY, 0-DATEPART(WEEKDAY, GETDATE()), DATEDIFF(dd, 0, GETDATE()))) --last day current week

SELECT DATEADD(wk, 2, DATEADD(DAY, 0-DATEPART(WEEKDAY, GETDATE()), DATEDIFF(dd, 0, GETDATE()))) --last day next week

نمایش اعداد جامانده در یک ستون از جدول دیتابیس sql

برای نمایش اعدادی که در یک بازه خاص وجود ندارند یا به عبارتی فضای خالی بین اعداد را نشان دهد از کد زیر استفاده نمایید

;With CTERange

    As (

    select (select isnull(max(ArchiveID)+1,1) from tblArchives where ArchiveID < md.ArchiveID) as [from],

         md.ArchiveID - 1 as [to]

      from tblArchives md

      where md.ArchiveID != 1 and not exists (

            select 1 from tblArchives md2 where md2.ArchiveID = md.ArchiveID - 1)

    ) SELECT [from], [to], ([to]-[from])+1 [total missing]

    From CTERange 

    ORDER BY ([to]-[from])+1 DESC;

استفاده از messageBox به جای messageDlg در دلفی

استفاده از messageBox به جای messageDlg در دلفی این امکان را میدهد که تعیین نمایید کدام دکمه فعال باشد . به عنوان مثال برای فعال بودن دکمه no از کد زیر استفاده میکنیم

if MessageBox(0, 'Message...', 'MessageBox caption', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_TASKMODAL) = IDYES then

ایجاد عدد رندم در sql

ایجاد عدد رندم  12 رقم ی در sql  از کد زیر استفاده نمایید

convert(numeric(12,0),rand() * 999999999999) 

عدم تغییر رنگ یک کنترل خاص بعد از دادن استایل دلفی

  بعد از دادن استایل در دلفی ، تمام کنترل ها به رنگ و تم انتخابی تغییر میکنند  . برای اینکه یکسری از کنترل ها رو رنگ دلخواه بگذارید از تابع زیر استفاده کنید

procedure DisableVclStyles(Control : TControl;const ClassToIgnore:string);
var
  i : Integer;
begin
  if Control=nil then
    Exit;
   Control.StyleElements:=[];
  if not Control.ClassNameIs(ClassToIgnore) then
  if Control is TWinControl then
      DisableVclStyles(TWinControl(Control).Controls[i], ClassToIgnore);
    for i := 0 to TWinControl(Control).ControlCount-1 do
end;

برای فراخوانی نیز از کد زیر استفاده نمایید

DisableVclStyles(Self,'TButton');

تغییر scroll پنل در زمان runtime

در صورت ایجاد ابجکت ها در زمان اجرا در داخل اسکرول باکس پرش به وجود می اید میتوان با گذاشتن یک پنل و یک اسکرول بار روی فرم و نوشتن کد زیر برای اسکرول این کار را شبیه سازی نمایید . همچنین یک متغیر ایکس سراسری تعریف و در زمان ایجاد فرم برابر با صفر گذاشته شود . 

procedure TForm1.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;

  var ScrollPos: Integer);

begin

  if ScrollPos>x then

    Panel1.ScrollBy(0, -ScrollPos);

  if ScrollPos<x then

    Panel1.ScrollBy(0, ScrollPos);

  panel1.repaint;

  x:=ScrollPos;

end;